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 Just execute the specified unit (see next option)." "--list-tests List all the available test units." - "--clients Number of test clients (16)." + "--clients Number of test clients (default 16)." + "--timeout 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