+ } elseif {$status eq {testing}} {
+ # No op
+ } else {
+ if {!$::quiet} {
+ puts "\[$status\]: $data"
+ }
+ }
+}
+
+# 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 {
+ # Remove this fd from the list of active clients.
+ set ::active_clients \
+ [lsearch -all -inline -not -exact $::active_clients $fd]
+ # New unit to process?
+ if {$::next_test != [llength $::all_tests]} {
+ if {!$::quiet} {
+ puts [colorstr bold-white "Testing [lindex $::all_tests $::next_test]"]
+ }
+ set ::clients_start_time($fd) [clock seconds]
+ send_data_packet $fd run [lindex $::all_tests $::next_test]
+ lappend ::active_clients $fd
+ incr ::next_test
+ } else {
+ lappend ::idle_clients $fd
+ if {[llength $::active_clients] == 0} {
+ the_end
+ }
+ }
+}
+
+# The the_end funciton gets called when all the test units were already
+# executed, so the test finished.
+proc the_end {} {
+ # TODO: print the status, exit with the rigth exit code.
+ puts "\n The End\n"
+ puts "Execution time of different units:"
+ foreach {time name} $::clients_time_history {
+ puts " $time seconds - $name"
+ }
+ if {[llength $::failed_tests]} {
+ puts "\n[colorstr bold-red {!!! WARNING}] The following tests failed:\n"
+ foreach failed $::failed_tests {
+ puts "*** $failed"
+ }
+ cleanup
+ exit 1
+ } else {
+ puts "\n[colorstr bold-white {\o/}] [colorstr bold-green {All tests passed without errors!}]\n"
+ cleanup
+ exit 0
+ }
+}
+
+# The client is not even driven (the test server is instead) as we just need
+# to read the command, execute, reply... all this in a loop.
+proc test_client_main server_port {
+ set ::test_server_fd [socket localhost $server_port]
+ send_data_packet $::test_server_fd ready [pid]
+ while 1 {
+ set bytes [gets $::test_server_fd]
+ set payload [read $::test_server_fd $bytes]
+ foreach {cmd data} $payload break
+ if {$cmd eq {run}} {
+ execute_tests $data
+ } else {
+ error "Unknown test client command: $cmd"
+ }
+ }
+}
+
+proc send_data_packet {fd status data} {
+ set payload [list $status $data]
+ puts $fd [string length $payload]
+ puts -nonewline $fd $payload
+ flush $fd
+}
+
+proc print_help_screen {} {
+ puts [join {
+ "--valgrind Run the test over valgrind."
+ "--accurate Run slow randomized tests for more iterations."
+ "--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)."
+ "--force-failure Force the execution of a test that always fails."
+ "--help Print this help screen."
+ } "\n"]
+}
+
+# parse arguments
+for {set j 0} {$j < [llength $argv]} {incr j} {
+ set opt [lindex $argv $j]
+ set arg [lindex $argv [expr $j+1]]
+ if {$opt eq {--tags}} {
+ foreach tag $arg {
+ if {[string index $tag 0] eq "-"} {
+ lappend ::denytags [string range $tag 1 end]
+ } else {
+ lappend ::allowtags $tag
+ }
+ }
+ incr j
+ } elseif {$opt eq {--valgrind}} {
+ set ::valgrind 1
+ } elseif {$opt eq {--quiet}} {
+ set ::quiet 1
+ } elseif {$opt eq {--host}} {
+ set ::external 1
+ set ::host $arg
+ incr j
+ } elseif {$opt eq {--port}} {
+ set ::port $arg
+ incr j
+ } elseif {$opt eq {--accurate}} {
+ set ::accurate 1
+ } elseif {$opt eq {--force-failure}} {
+ set ::force_failure 1
+ } elseif {$opt eq {--single}} {
+ set ::all_tests $arg
+ incr j
+ } elseif {$opt eq {--list-tests}} {
+ foreach t $::all_tests {
+ puts $t
+ }
+ exit 0
+ } elseif {$opt eq {--client}} {
+ 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
+ } else {
+ puts "Wrong argument: $opt"
+ exit 1
+ }
+}
+
+# With the parallel test running multiple Redis instances at the same time
+# we need a fast enough computer, otherwise a lot of tests may generate
+# false positives.
+# If the computer is too slow we revert the sequetial test without any
+# parallelism, that is, clients == 1.
+proc is_a_slow_computer {} {
+ set start [clock milliseconds]
+ for {set j 0} {$j < 1000000} {incr j} {}
+ set elapsed [expr [clock milliseconds]-$start]
+ expr {$elapsed > 200}
+}
+
+if {$::client} {
+ if {[catch { test_client_main $::test_server_port } err]} {
+ set estr "Executing test client: $err.\n$::errorInfo"
+ if {[catch {send_data_packet $::test_server_fd exception $estr}]} {
+ puts $estr
+ }
+ exit 1
+ }
+} else {
+ if {[is_a_slow_computer]} {
+ puts "** SLOW COMPUTER ** Using a single client to avoid false positives."
+ set ::numclients 1
+ }
+
+ if {[catch { test_server_main } err]} {
+ if {[string length $err] > 0} {
+ # only display error when not generated by the test suite
+ if {$err ne "exception"} {
+ puts $::errorInfo
+ }
+ exit 1
+ }