Record Tcl errors and dump them again at the end of a run

1 files changed, 17 insertions, 1 deletions

diff --git a/runtest.exp b/runtest.exp
index 6f7e557..83c4140 100644
--- a/runtest.exp
+++ b/runtest.exp
@@ -104,6 +104,14 @@ namespace eval ::dejagnu::opt {
     variable keep_going	1	;# continue after a fatal error in testcase?
 }
 
+#
+# Collected errors
+#
+namespace eval ::dejagnu::error {
+    # list of { file message errorCode errorInfo } lists
+    variable list [list]
+}
+
 # Various ccache versions provide incorrect debug info such as ignoring
 # different current directory, breaking GDB testsuite.
 set env(CCACHE_DISABLE) 1
@@ -1587,7 +1595,7 @@ proc runtest { test_file_name } {
 	    }
 	}
 
-	if { [catch "uplevel #0 source $test_file_name"] == 1 } {
+	if { [catch "uplevel #0 source $test_file_name" msg] == 1 } {
 	    # If we have a Tcl error, propagate the exit status so
 	    # that 'make' (if it invokes runtest) notices the error.
 	    global exit_status exit_error
@@ -1595,6 +1603,7 @@ proc runtest { test_file_name } {
 	    if { $exit_status == 0 } {
 		set exit_status 2
 	    }
+	    set new_error [list $test_file_name $msg]
 	    # We can't call `perror' here, it resets `errorInfo'
 	    # before we want to look at it.  Also remember that perror
 	    # increments `errcnt'.  If we do call perror we'd have to
@@ -1602,11 +1611,18 @@ proc runtest { test_file_name } {
 	    clone_output "ERROR: tcl error sourcing $test_file_name."
 	    if {[info exists errorCode]} {
 		clone_output "ERROR: tcl error code $errorCode"
+		lappend new_error $errorCode
+	    } else {
+		lappend new_error [list]
 	    }
 	    if {[info exists errorInfo]} {
 		clone_output "ERROR: $errorInfo"
+		lappend new_error $errorInfo
 		unset errorInfo
+	    } else {
+		lappend new_error [list]
 	    }
+	    lappend ::dejagnu::error::list $new_error
 	    unresolved "testcase '$test_file_name' aborted due to Tcl error"
 	    if { ! $::dejagnu::opt::keep_going } { log_and_exit }
 	}