set ::file ""; # If set, runs only the tests in this comma separated list
set ::curfile ""; # Hold the filename of the current suite
set ::accurate 0; # If true runs fuzz tests with more iterations
+set ::force_failure 0
# 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
set ::active_clients {}
array set ::clients_start_time {}
set ::clients_time_history {}
+ set ::failed_tests {}
# Enter the event loop to handle clients I/O
after 100 test_server_cron
} elseif {$status eq {ok}} {
puts "\[[colorstr green $status]\]: $data"
} elseif {$status eq {err}} {
- puts "\[[colorstr red $status]\]: $data"
+ set err "\[[colorstr red $status]\]: $data"
+ puts $err
+ lappend ::failed_tests $err
} elseif {$status eq {exception}} {
puts "\[[colorstr red $status]\]: $data"
foreach p $::clients_pids {
# executed, so the test finished.
proc the_end {} {
# TODO: print the status, exit with the rigth exit code.
- puts "The End\n"
+ puts "\n The End\n"
puts "Execution time of different units:"
foreach {time name} $::clients_time_history {
puts " $time seconds - $name"
}
- exit 1
+ if {[llength $::failed_tests]} {
+ puts "\n[colorstr bold-red {!!! WARNING}] The following tests failed:\n"
+ foreach failed $::failed_tests {
+ puts "*** $failed"
+ }
+ exit 1
+ } else {
+ puts "\n[colorstr bold-white {\o/}] [colorstr bold-green {All tests passed without errors!}]\n"
+ exit 0
+ }
}
# The client is not even driven (the test server is instead) as we just need
flush $fd
}
+proc print_help_screen {} {
+ puts [join {
+ "--valgrind Run the test over valgrind."
+ "--accurate Run slow randomized tests for more iterations."
+ "--single <unit> Just execute the specified unit (see next option)."
+ "--list-tests List all the available test units."
+ "--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]
incr j
} elseif {$opt eq {--valgrind}} {
set ::valgrind 1
- } elseif {$opt eq {--file}} {
- set ::file $arg
- incr j
} elseif {$opt eq {--host}} {
set ::external 1
set ::host $arg
} elseif {$opt eq {--port}} {
set ::port $arg
incr j
- } elseif {$opt eq {--verbose}} {
- set ::verbose 1
} 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
set ::test_server_port $arg
incr j
} elseif {$opt eq {--help}} {
- puts "TODO print an help screen"
+ print_help_screen
exit 0
} else {
puts "Wrong argument: $opt"