From 81476c0cf7e9a60aed45f01cc2c2230972acff36 Mon Sep 17 00:00:00 2001
From: Oran Agra <oran@redislabs.com>
Date: Mon, 31 Aug 2020 11:24:17 +0300
Subject: [PATCH] test infra - add durable mode to work around test suite
 crashing

in some cases a command that returns an error possibly due to a timing
issue causes the tcl code to crash and thus prevents the rest of the
tests from running. this adds an option to make the test proceed despite
the crash.
maybe it should be the default mode some day.

(cherry picked from commit cf22e8eb91c2c1a769fda4c4de9eba3163dd7f05)
---
 tests/support/server.tcl | 28 ++++++++++++++++++++++++++--
 tests/support/test.tcl   |  6 +++++-
 tests/test_helper.tcl    |  4 ++++
 3 files changed, 35 insertions(+), 3 deletions(-)

diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 9894e6f2a..f2f6ceece 100644
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -297,7 +297,20 @@ proc start_server {options {code undefined}} {
             lappend ::servers $srv
         }
         r flushall
-        uplevel 1 $code
+        if {[catch {set retval [uplevel 1 $code]} error]} {
+            if {$::durable} {
+                set msg [string range $error 10 end]
+                lappend details $msg
+                lappend details $::errorInfo
+                lappend ::tests_failed $details
+
+                incr ::num_failed
+                send_data_packet $::test_server_fd err [join $details "\n"]
+            } else {
+                # Re-raise, let handler up the stack take care of this.
+                error $error $::errorInfo
+            }
+        }
         set ::tags [lrange $::tags 0 end-[llength $tags]]
         return
     }
@@ -468,7 +481,18 @@ proc start_server {options {code undefined}} {
             }
             puts ""
 
-            error $error $backtrace
+            if {$::durable} {
+                set msg [string range $error 10 end]
+                lappend details $msg
+                lappend details $backtrace
+                lappend ::tests_failed $details
+
+                incr ::num_failed
+                send_data_packet $::test_server_fd err [join $details "\n"]
+            } else {
+                # Re-raise, let handler up the stack take care of this.
+                error $error $backtrace
+            }
         }
 
         # fetch srv back from the server list, in case it was restarted by restart_server (new PID)
diff --git a/tests/support/test.tcl b/tests/support/test.tcl
index 773461abb..f5b4c8bef 100644
--- a/tests/support/test.tcl
+++ b/tests/support/test.tcl
@@ -149,9 +149,13 @@ proc test {name code {okpattern undefined} {options undefined}} {
     send_data_packet $::test_server_fd testing $name
 
     if {[catch {set retval [uplevel 1 $code]} error]} {
-        if {[string match "assertion:*" $error]} {
+        set assertion [string match "assertion:*" $error]
+        if {$assertion || $::durable} {
             set msg [string range $error 10 end]
             lappend details $msg
+            if {!$assertion} {
+                lappend details $::errorInfo
+            }
             lappend ::tests_failed $details
 
             incr ::num_failed
diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index 4a470ec30..fe2d484b8 100644
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -79,6 +79,7 @@ set ::baseport 21111; # initial port for spawned redis servers
 set ::portcount 8000; # we don't wanna use more than 10000 to avoid collision with cluster bus ports
 set ::traceleaks 0
 set ::valgrind 0
+set ::durable 0
 set ::tls 0
 set ::stack_logging 0
 set ::verbose 0
@@ -521,6 +522,7 @@ proc send_data_packet {fd status data} {
 proc print_help_screen {} {
     puts [join {
         "--valgrind         Run the test over valgrind."
+        "--durable          suppress test crashes and keep running"
         "--stack-logging    Enable OSX leaks/malloc stack logging."
         "--accurate         Run slow randomized tests for more iterations."
         "--quiet            Don't show individual tests."
@@ -633,6 +635,8 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
     } elseif {$opt eq {--clients}} {
         set ::numclients $arg
         incr j
+    } elseif {$opt eq {--durable}} {
+        set ::durable 1
     } elseif {$opt eq {--dont-clean}} {
         set ::dont_clean 1
     } elseif {$opt eq {--wait-server}} {