Test: try to cleanup still running Redis instances on exit.

It's hard to run the Redis test continuously if it leaks processes on
exceptions / errors.

2 files changed, 27 insertions, 9 deletions

diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 0e2e2982a..8f8461bb5 100644
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -70,6 +70,9 @@ proc kill_server config {
     if {$::valgrind} {
         check_valgrind_errors [dict get $config stderr]
     }
+
+    # Remove this pid from the set of active pids in the test server.
+    send_data_packet $::test_server_fd server-killed $pid
 }
 
 proc is_alive config {
@@ -204,11 +207,14 @@ proc start_server {options {code undefined}} {
     set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
 
     if {$::valgrind} {
-        exec valgrind --suppressions=src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file > $stdout 2> $stderr &
+        set pid [exec valgrind --suppressions=src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file > $stdout 2> $stderr &]
     } else {
-        exec src/redis-server $config_file > $stdout 2> $stderr &
+        set pid [exec src/redis-server $config_file > $stdout 2> $stderr &]
     }
 
+    # Tell the test server about this new instance.
+    send_data_packet $::test_server_fd server-spawned $pid
+
     # check that the server actually started
     # ugly but tries to be as fast as possible...
     if {$::valgrind} {set retrynum 1000} else {set retrynum 100}
@@ -234,12 +240,6 @@ proc start_server {options {code undefined}} {
         return
     }
 
-    # find out the pid
-    while {![info exists pid]} {
-        regexp {PID:\s(\d+)} [exec cat $stdout] _ pid
-        after 100
-    }
-
     # setup properties to be able to initialize a client object
     set host $::host
     set port $::port
diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index 182975571..212c95b4f 100644
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -67,6 +67,7 @@ set ::accurate 0; # If true runs fuzz tests with more iterations
 set ::force_failure 0
 set ::timeout 600; # 10 minutes without progresses will quit the test.
 set ::last_progress [clock seconds]
+set ::active_servers {} ; # Pids of active Redis instances.
 
 # Set to 1 when we are running in client mode. The Redis test uses a
 # server-client model to run tests simultaneously. The server instance
@@ -211,6 +212,7 @@ proc test_server_cron {} {
         puts $err
         show_clients_state
         kill_clients
+        force_kill_all_servers
         the_end
     }
 
@@ -268,9 +270,14 @@ proc read_from_test_client fd {
     } elseif {$status eq {exception}} {
         puts "\[[colorstr red $status]\]: $data"
         kill_clients
+        force_kill_all_servers
         exit 1
     } elseif {$status eq {testing}} {
         set ::active_clients_task($fd) "(IN PROGRESS) $data"
+    } elseif {$status eq {server-spawned}} {
+        lappend ::active_servers $data
+    } elseif {$status eq {server-killed}} {
+        set ::active_servers [lsearch -all -inline -not -exact $::active_servers $data]
     } else {
         if {!$::quiet} {
             puts "\[$status\]: $data"
@@ -296,6 +303,13 @@ proc kill_clients {} {
     }
 }
 
+proc force_kill_all_servers {} {
+    foreach p $::active_servers {
+        puts "Killing still running Redis server $p"
+        catch {exec kill -9 $p}
+    }
+}
+
 # A new client is idle. Remove it from the list of active clients and
 # if there are still test units to run, launch them.
 proc signal_idle_client fd {
@@ -378,7 +392,8 @@ proc print_help_screen {} {
         "--quiet            Don't show individual tests."
         "--single <unit>    Just execute the specified unit (see next option)."
         "--list-tests       List all the available test units."
-        "--clients <num>    Number of test clients (16)."
+        "--clients <num>    Number of test clients (default 16)."
+        "--timeout <sec>    Test timeout in seconds (default 10 min)."
         "--force-failure    Force the execution of a test that always fails."
         "--help             Print this help screen."
     } "\n"]
@@ -427,6 +442,9 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
     } elseif {$opt eq {--clients}} {
         set ::numclients $arg
         incr j
+    } elseif {$opt eq {--timeout}} {
+        set ::timeout $arg
+        incr j
     } elseif {$opt eq {--help}} {
         print_help_screen
         exit 0