test infra - add durable mode to work around test suite crashing
in some cases a command that returns an error possibly due to a timing issue causes the tcl code to crash and thus prevents the rest of the tests from running. this adds an option to make the test proceed despite the crash. maybe it should be the default mode some day. (cherry picked from commit fe5da2e60d8d6d907062f4789673fbe06fa8773e)
This commit is contained in:
parent
db6c763d8b
commit
41c7c7919c
@ -297,7 +297,20 @@ proc start_server {options {code undefined}} {
|
|||||||
lappend ::servers $srv
|
lappend ::servers $srv
|
||||||
}
|
}
|
||||||
r flushall
|
r flushall
|
||||||
uplevel 1 $code
|
if {[catch {set retval [uplevel 1 $code]} error]} {
|
||||||
|
if {$::durable} {
|
||||||
|
set msg [string range $error 10 end]
|
||||||
|
lappend details $msg
|
||||||
|
lappend details $::errorInfo
|
||||||
|
lappend ::tests_failed $details
|
||||||
|
|
||||||
|
incr ::num_failed
|
||||||
|
send_data_packet $::test_server_fd err [join $details "\n"]
|
||||||
|
} else {
|
||||||
|
# Re-raise, let handler up the stack take care of this.
|
||||||
|
error $error $::errorInfo
|
||||||
|
}
|
||||||
|
}
|
||||||
set ::tags [lrange $::tags 0 end-[llength $tags]]
|
set ::tags [lrange $::tags 0 end-[llength $tags]]
|
||||||
return
|
return
|
||||||
}
|
}
|
||||||
@ -468,7 +481,18 @@ proc start_server {options {code undefined}} {
|
|||||||
}
|
}
|
||||||
puts ""
|
puts ""
|
||||||
|
|
||||||
error $error $backtrace
|
if {$::durable} {
|
||||||
|
set msg [string range $error 10 end]
|
||||||
|
lappend details $msg
|
||||||
|
lappend details $backtrace
|
||||||
|
lappend ::tests_failed $details
|
||||||
|
|
||||||
|
incr ::num_failed
|
||||||
|
send_data_packet $::test_server_fd err [join $details "\n"]
|
||||||
|
} else {
|
||||||
|
# Re-raise, let handler up the stack take care of this.
|
||||||
|
error $error $backtrace
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# fetch srv back from the server list, in case it was restarted by restart_server (new PID)
|
# fetch srv back from the server list, in case it was restarted by restart_server (new PID)
|
||||||
|
@ -149,9 +149,13 @@ proc test {name code {okpattern undefined} {options undefined}} {
|
|||||||
send_data_packet $::test_server_fd testing $name
|
send_data_packet $::test_server_fd testing $name
|
||||||
|
|
||||||
if {[catch {set retval [uplevel 1 $code]} error]} {
|
if {[catch {set retval [uplevel 1 $code]} error]} {
|
||||||
if {[string match "assertion:*" $error]} {
|
set assertion [string match "assertion:*" $error]
|
||||||
|
if {$assertion || $::durable} {
|
||||||
set msg [string range $error 10 end]
|
set msg [string range $error 10 end]
|
||||||
lappend details $msg
|
lappend details $msg
|
||||||
|
if {!$assertion} {
|
||||||
|
lappend details $::errorInfo
|
||||||
|
}
|
||||||
lappend ::tests_failed $details
|
lappend ::tests_failed $details
|
||||||
|
|
||||||
incr ::num_failed
|
incr ::num_failed
|
||||||
|
@ -79,6 +79,7 @@ set ::baseport 21111; # initial port for spawned redis servers
|
|||||||
set ::portcount 8000; # we don't wanna use more than 10000 to avoid collision with cluster bus ports
|
set ::portcount 8000; # we don't wanna use more than 10000 to avoid collision with cluster bus ports
|
||||||
set ::traceleaks 0
|
set ::traceleaks 0
|
||||||
set ::valgrind 0
|
set ::valgrind 0
|
||||||
|
set ::durable 0
|
||||||
set ::tls 0
|
set ::tls 0
|
||||||
set ::stack_logging 0
|
set ::stack_logging 0
|
||||||
set ::verbose 0
|
set ::verbose 0
|
||||||
@ -521,6 +522,7 @@ proc send_data_packet {fd status data} {
|
|||||||
proc print_help_screen {} {
|
proc print_help_screen {} {
|
||||||
puts [join {
|
puts [join {
|
||||||
"--valgrind Run the test over valgrind."
|
"--valgrind Run the test over valgrind."
|
||||||
|
"--durable suppress test crashes and keep running"
|
||||||
"--stack-logging Enable OSX leaks/malloc stack logging."
|
"--stack-logging Enable OSX leaks/malloc stack logging."
|
||||||
"--accurate Run slow randomized tests for more iterations."
|
"--accurate Run slow randomized tests for more iterations."
|
||||||
"--quiet Don't show individual tests."
|
"--quiet Don't show individual tests."
|
||||||
@ -633,6 +635,8 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
|
|||||||
} elseif {$opt eq {--clients}} {
|
} elseif {$opt eq {--clients}} {
|
||||||
set ::numclients $arg
|
set ::numclients $arg
|
||||||
incr j
|
incr j
|
||||||
|
} elseif {$opt eq {--durable}} {
|
||||||
|
set ::durable 1
|
||||||
} elseif {$opt eq {--dont-clean}} {
|
} elseif {$opt eq {--dont-clean}} {
|
||||||
set ::dont_clean 1
|
set ::dont_clean 1
|
||||||
} elseif {$opt eq {--wait-server}} {
|
} elseif {$opt eq {--wait-server}} {
|
||||||
|
Loading…
x
Reference in New Issue
Block a user