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

@@ -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"