catch exceptions in the server proc, to be able to kill the entire chain of running servers

This commit is contained in:
Pieter Noordhuis 2010-06-02 21:20:29 +02:00
parent d55d5c5dd3
commit 436f18b618
3 changed files with 36 additions and 18 deletions

View File

@ -27,11 +27,13 @@ proc kill_server config {
set pid [dict get $config pid]
# check for leaks
catch {
if {[string match {*Darwin*} [exec uname -a]]} {
test "Check for memory leaks (pid $pid)" {
exec leaks $pid
} {*0 leaks*}
if {![dict exists $config "skipleaks"]} {
catch {
if {[string match {*Darwin*} [exec uname -a]]} {
test "Check for memory leaks (pid $pid)" {
exec leaks $pid
} {*0 leaks*}
}
}
}
@ -182,13 +184,27 @@ proc start_server {filename overrides {code undefined}} {
# pop the server object
set ::servers [lrange $::servers 0 end-1]
kill_server $srv
if {[string length $err] > 0} {
# allow an exception to bubble up the call chain but still kill this
# server, because we want to reuse the ports when the tests are re-run
if {$err eq "exception"} {
puts [format "Logged warnings (pid %d):" [dict get $srv "pid"]]
set warnings [warnings_from_file [dict get $srv "stdout"]]
if {[string length $warnings] > 0} {
puts "$warnings"
} else {
puts "(none)"
}
# kill this server without checking for leaks
dict set srv "skipleaks" 1
kill_server $srv
error "exception"
} elseif {[string length $err] > 0} {
puts "Error executing the suite, aborting..."
puts $err
exit 1
}
kill_server $srv
} else {
set _ $srv
}

View File

@ -8,15 +8,9 @@ proc test {name code okpattern} {
puts -nonewline [format "#%03d %-68s " $::testnum $name]
flush stdout
if {[catch {set retval [uplevel 1 $code]} error]} {
puts "ERROR\n\nLogged warnings:"
foreach file [glob tests/tmp/server.[pid].*/stdout] {
set warnings [warnings_from_file $file]
if {[string length $warnings] > 0} {
puts $warnings
}
}
puts "Script died with $error"
exit 1
puts "EXCEPTION"
puts "\nCaught error: $error"
error "exception"
}
if {$okpattern eq $retval || [string match $okpattern $retval]} {
puts "PASSED"

View File

@ -92,4 +92,12 @@ proc main {} {
cleanup
}
main
if {[catch { main } err]} {
if {[string length $err] > 0} {
# only display error when not generated by the test suite
if {$err ne "exception"} {
puts $err
}
exit 1
}
}