From 13566085cf67f7417e60c10cc272c68ec8608b81 Mon Sep 17 00:00:00 2001 From: antirez Date: Sun, 10 Jul 2011 23:25:48 +0200 Subject: [PATCH] Initial implementation of a client-server parallel testing system for Redis in order to speedup execution of the test suite. --- tests/support/test.tcl | 41 +------ tests/support/tmpfile.tcl | 8 +- tests/test_helper.tcl | 234 +++++++++++++++++++++++++++----------- tests/unit/other.tcl | 22 ++-- 4 files changed, 182 insertions(+), 123 deletions(-) diff --git a/tests/support/test.tcl b/tests/support/test.tcl index dff2d297..4819d8a3 100644 --- a/tests/support/test.tcl +++ b/tests/support/test.tcl @@ -49,15 +49,6 @@ proc color_term {} { expr {[info exists ::env(TERM)] && [string match *xterm* $::env(TERM)]} } -# This is called before starting the test -proc announce_test {s} { - if {[color_term]} { - puts -nonewline "$s\033\[0K" - flush stdout - set ::backward_count [string length $s] - } -} - # This is called after the test finished proc colored_dot {tags passed} { if {[color_term]} { @@ -131,12 +122,7 @@ proc test {name code {okpattern undefined}} { lappend details $::tags lappend details $name - if {$::verbose} { - puts -nonewline [format "#%03d %-68s " $::num_tests $name] - flush stdout - } else { - announce_test $name - } + send_data_packet $::test_server_fd testing $name if {[catch {set retval [uplevel 1 $code]} error]} { if {[string match "assertion:*" $error]} { @@ -145,12 +131,7 @@ proc test {name code {okpattern undefined}} { lappend ::tests_failed $details incr ::num_failed - if {$::verbose} { - puts "FAILED" - puts "$msg\n" - } else { - colored_dot $::tags 0 - } + send_data_packet $::test_server_fd err $name } else { # Re-raise, let handler up the stack take care of this. error $error $::errorInfo @@ -158,33 +139,21 @@ proc test {name code {okpattern undefined}} { } else { if {$okpattern eq "undefined" || $okpattern eq $retval || [string match $okpattern $retval]} { incr ::num_passed - if {$::verbose} { - puts "PASSED" - } else { - colored_dot $::tags 1 - } + send_data_packet $::test_server_fd ok $name } else { set msg "Expected '$okpattern' to equal or match '$retval'" lappend details $msg lappend ::tests_failed $details incr ::num_failed - if {$::verbose} { - puts "FAILED" - puts "$msg\n" - } else { - colored_dot $::tags 0 - } + send_data_packet $::test_server_fd err $name } } - flush stdout if {$::traceleaks} { set output [exec leaks redis-server] if {![string match {*0 leaks*} $output]} { - puts "--- Test \"$name\" leaked! ---" - puts $output - exit 1 + send_data_packet $::test_server_fd err "Detected a memory leak in test '$name': $output" } } } diff --git a/tests/support/tmpfile.tcl b/tests/support/tmpfile.tcl index 287b0931..809f5873 100644 --- a/tests/support/tmpfile.tcl +++ b/tests/support/tmpfile.tcl @@ -4,13 +4,7 @@ file mkdir $::tmproot # returns a dirname unique to this process to write to proc tmpdir {basename} { - if {$::diskstore} { - # For diskstore we want to use the same dir again and again - # otherwise everything is too slow. - set dir [file join $::tmproot $basename.diskstore] - } else { - set dir [file join $::tmproot $basename.[pid].[incr ::tmpcounter]] - } + set dir [file join $::tmproot $basename.[pid].[incr ::tmpcounter]] file mkdir $dir set _ $dir } diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl index f034299f..f72d9712 100644 --- a/tests/test_helper.tcl +++ b/tests/test_helper.tcl @@ -9,6 +9,28 @@ source tests/support/tmpfile.tcl source tests/support/test.tcl source tests/support/util.tcl +set ::all_tests { + unit/printver + unit/auth + unit/protocol + unit/basic + unit/type/list + unit/type/set + unit/type/zset + unit/type/hash + unit/sort + unit/expire + unit/other + unit/cas + unit/quit + integration/replication + integration/aof + unit/pubsub + unit/slowlog +} +# Index to the next test to run in the ::all_tests list. +set ::next_test 0 + set ::host 127.0.0.1 set ::port 16379 set ::traceleaks 0 @@ -19,12 +41,20 @@ set ::allowtags {} set ::external 0; # If "1" this means, we are running against external instance set ::file ""; # If set, runs only the tests in this comma separated list set ::curfile ""; # Hold the filename of the current suite -set ::diskstore 0; # Don't touch this by hand. The test itself will toggle it. + +# 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 +# runs the specified number of client instances that will actually run tests. +# The server is responsible of showing the result to the user, and exit with +# the appropriate exit code depending on the test outcome. +set ::client 0 +set ::numclients 16 proc execute_tests name { set path "tests/$name.tcl" set ::curfile $path source $path + send_data_packet $::test_server_fd done "$name finished" } # Setup a list to hold a stack of server configs. When calls to start_server @@ -104,80 +134,138 @@ proc s {args} { } proc cleanup {} { - puts "Cleanup: warning may take some time..." + puts -nonewline "Cleanup: warning may take some time... " + flush stdout catch {exec rm -rf {*}[glob tests/tmp/redis.conf.*]} catch {exec rm -rf {*}[glob tests/tmp/server.*]} + puts "OK" } -proc execute_everything {} { - if 0 { - # Use this when hacking on new tests. - set ::verbose 1 - execute_tests "unit/first" - return +proc test_server_main {} { + cleanup + # Open a listening socket, trying different ports in order to find a + # non busy one. + set port 11111 + while 1 { + puts "Starting test server at port $port" + if {[catch {socket -server accept_test_clients $port} e]} { + if {[string match {*address already in use*} $e]} { + if {$port == 20000} { + puts "Can't find an available TCP port for test server." + exit 1 + } else { + incr port + } + } else { + puts "Fatal error starting test server: $e" + exit 1 + } + } else { + break + } } - execute_tests "unit/printver" - execute_tests "unit/auth" - execute_tests "unit/protocol" - execute_tests "unit/basic" - execute_tests "unit/type/list" - execute_tests "unit/type/set" - execute_tests "unit/type/zset" - execute_tests "unit/type/hash" - execute_tests "unit/sort" - execute_tests "unit/expire" - execute_tests "unit/other" - execute_tests "unit/cas" - execute_tests "unit/quit" - execute_tests "integration/replication" - execute_tests "integration/aof" - execute_tests "unit/pubsub" - execute_tests "unit/slowlog" -} - -proc main {} { - cleanup - set exit_with_error 0 + # Start the client instances + for {set j 0} {$j < $::numclients} {incr j} { + exec tclsh8.5 [info script] {*}$::argv \ + --client $port --port [expr {$::port+($j*10)}] & + } - if {[string length $::file] > 0} { - foreach {file} [split $::file ,] { - execute_tests $file - } + # Setup global state for the test server + set ::idle_clients {} + set ::active_clients {} + + # Enter the event loop to handle clients I/O + after 100 test_server_cron + vwait forever +} + +# This function gets called 10 times per second, for now does nothing but +# may be used in the future in order to detect test clients taking too much +# time to execute the task. +proc test_server_cron {} { +} + +proc accept_test_clients {fd addr port} { + fileevent $fd readable [list read_from_test_client $fd] +} + +# This is the readable handler of our test server. Clients send us messages +# in the form of a status code such and additional data. Supported +# status types are: +# +# ready: the client is ready to execute the command. Only sent at client +# startup. The server will queue the client FD in the list of idle +# clients. +# testing: just used to signal that a given test started. +# ok: a test was executed with success. +# err: a test was executed with an error. +# exception: there was a runtime exception while executing the test. +# done: all the specified test file was processed, this test client is +# ready to accept a new task. +proc read_from_test_client fd { + set bytes [gets $fd] + set payload [read $fd $bytes] + foreach {status data} $payload break + puts "($fd) \[$status\]: $data" + if {$status eq {ready}} { + signal_idle_client $fd + } elseif {$status eq {done}} { + signal_idle_client $fd + puts "+++ [llength $::active_clients] units still in execution." + } +} + +# 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]} { + puts "Spawing new test process for: [lindex $::all_tests $::next_test]" + send_data_packet $fd run [lindex $::all_tests $::next_test] + lappend ::active_clients $fd + incr ::next_test } else { - execute_everything + lappend ::idle_clients $fd + if {[llength $::active_clients] == 0} { + the_end + } } +} - cleanup - puts "\n[expr $::num_tests] tests, $::num_passed passed, $::num_failed failed\n" - if {$::num_failed > 0} { - set curheader "" - puts "Failures:" - foreach {test} $::tests_failed { - set header [lindex $test 0] - append header " (" - append header [join [lindex $test 1] ","] - append header ")" - - if {$curheader ne $header} { - set curheader $header - puts "\n$curheader:" - } +# 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 "The End" + exit 1 +} - set name [lindex $test 2] - set msg [lindex $test 3] - puts "- $name: $msg" +# 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" } - - puts "" - incr exit_with_error } +} - if {[string length $::valgrind_errors]} { - puts "Valgrind errors:\n$::valgrind_errors" - incr exit_with_error - } - if {$exit_with_error} {exit 1} +proc send_data_packet {fd status data} { + set payload [list $status $data] + puts $fd [string length $payload] + puts -nonewline $fd $payload + flush $fd } # parse arguments @@ -207,18 +295,32 @@ for {set j 0} {$j < [llength $argv]} {incr j} { incr j } elseif {$opt eq {--verbose}} { set ::verbose 1 + } elseif {$opt eq {--client}} { + set ::client 1 + set ::test_server_port $arg + incr j } else { puts "Wrong argument: $opt" exit 1 } } -if {[catch { main } err]} { - if {[string length $err] > 0} { - # only display error when not generated by the test suite - if {$err ne "exception"} { - puts $::errorInfo +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 {[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 + } + } } diff --git a/tests/unit/other.tcl b/tests/unit/other.tcl index 716d6897..d2663572 100644 --- a/tests/unit/other.tcl +++ b/tests/unit/other.tcl @@ -12,7 +12,7 @@ start_server {tags {"other"}} { r save } {OK} - tags {slow nodiskstore} { + tags {slow} { foreach fuzztype {binary alpha compr} { test "FUZZ stresser with data model $fuzztype" { set err 0 @@ -46,7 +46,7 @@ start_server {tags {"other"}} { set _ $err } {*invalid*} - tags {consistency nodiskstore} { + tags {consistency} { if {![catch {package require sha1}]} { test {Check consistency of different data types after a reload} { r flushdb @@ -102,25 +102,19 @@ start_server {tags {"other"}} { r flushdb r set x 10 r expire x 1000 - if {$::diskstore} { - r debug flushcache - } else { - r save - r debug reload - } + r save + r debug reload set ttl [r ttl x] set e1 [expr {$ttl > 900 && $ttl <= 1000}] - if {!$::diskstore} { - r bgrewriteaof - waitForBgrewriteaof r - r debug loadaof - } + r bgrewriteaof + waitForBgrewriteaof r + r debug loadaof set ttl [r ttl x] set e2 [expr {$ttl > 900 && $ttl <= 1000}] list $e1 $e2 } {1 1} - tags {protocol nodiskstore} { + tags {protocol} { test {PIPELINING stresser (also a regression for the old epoll bug)} { set fd2 [socket $::host $::port] fconfigure $fd2 -encoding binary -translation binary -- 2.47.2