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

tests/support/server.tcl

@@ -27,6 +27,7 @@ proc kill_server config {
     set pid [dict get $config pid]
 
     # check for leaks
+    if {![dict exists $config "skipleaks"]} {
         catch {
             if {[string match {*Darwin*} [exec uname -a]]} {
                 test "Check for memory leaks (pid $pid)" {
@@ -34,6 +35,7 @@ proc kill_server config {
                 } {*0 leaks*}
             }
         }
+    }
 
     # kill server and wait for the process to be totally exited
     while {[is_alive $config]} {
@@ -182,13 +184,27 @@ proc start_server {filename overrides {code undefined}} {
         # pop the server object
         set ::servers [lrange $::servers 0 end-1]
         
+        # 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"
-        if {[string length $err] > 0} {
+        } elseif {[string length $err] > 0} {
             puts "Error executing the suite, aborting..."
             puts $err
             exit 1
         }
+
+        kill_server $srv
     } else {
         set _ $srv
     }

tests/support/test.tcl

@@ -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:"
+        puts "EXCEPTION"
-        foreach file [glob tests/tmp/server.[pid].*/stdout] {
+        puts "\nCaught error: $error"
-            set warnings [warnings_from_file $file]
+        error "exception"
-            if {[string length $warnings] > 0} {
-                puts $warnings
-            }
-        }
-        puts "Script died with $error"
-        exit 1
     }
     if {$okpattern eq $retval || [string match $okpattern $retval]} {
         puts "PASSED"

tests/test_helper.tcl

@@ -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
+    }
+}