diff --git a/tests/support/server.tcl b/tests/support/server.tcl index 984270adb..b1ab38fc1 100644 --- a/tests/support/server.tcl +++ b/tests/support/server.tcl @@ -46,11 +46,16 @@ proc kill_server config { } # kill server and wait for the process to be totally exited + catch {exec kill $pid} while {[is_alive $config]} { - if {[incr wait 10] % 1000 == 0} { + incr wait 10 + + if {$wait >= 5000} { + puts "Forcing process $pid to exit..." + catch {exec kill -KILL $pid} + } elseif {$wait % 1000 == 0} { puts "Waiting for process $pid to exit..." } - catch {exec kill $pid} after 10 } diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl index 34d96606d..2ec3aad1c 100644 --- a/tests/test_helper.tcl +++ b/tests/test_helper.tcl @@ -345,6 +345,7 @@ 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)." "--force-failure Force the execution of a test that always fails." "--help Print this help screen." } "\n"] @@ -390,6 +391,9 @@ for {set j 0} {$j < [llength $argv]} {incr j} { set ::client 1 set ::test_server_port $arg incr j + } elseif {$opt eq {--clients}} { + set ::numclients $arg + incr j } elseif {$opt eq {--help}} { print_help_screen exit 0