mirror of
https://codeberg.org/redict/redict.git
synced 2025-01-22 08:08:53 -05:00
Initial implementation of a client-server parallel testing system for Redis in order to speedup execution of the test suite.
This commit is contained in:
antirez
parent
5ab1461f98
commit
13566085cf
@ -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"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
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 {} {
|
||||
proc test_server_main {} {
|
||||
cleanup
|
||||
set exit_with_error 0
|
||||
|
||||
if {[string length $::file] > 0} {
|
||||
foreach {file} [split $::file ,] {
|
||||
execute_tests $file
|
||||
}
|
||||
} else {
|
||||
execute_everything
|
||||
}
|
||||
|
||||
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:"
|
||||
# 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
|
||||
}
|
||||
|
||||
set name [lindex $test 2]
|
||||
set msg [lindex $test 3]
|
||||
puts "- $name: $msg"
|
||||
} else {
|
||||
break
|
||||
}
|
||||
|
||||
puts ""
|
||||
incr exit_with_error
|
||||
}
|
||||
|
||||
if {[string length $::valgrind_errors]} {
|
||||
puts "Valgrind errors:\n$::valgrind_errors"
|
||||
incr exit_with_error
|
||||
# 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 {$exit_with_error} {exit 1}
|
||||
|
||||
# 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 {
|
||||
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 "The End"
|
||||
exit 1
|
||||
}
|
||||
|
||||
# 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
|
||||
}
|
||||
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user