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

3 files changed, 35 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index 1584df6..8325b09 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2020-06-26  Jacob Bachmeyer  <jcb62281+dev@gmail.com>
+
+	PR 41824 / PR 41918
+
+	* lib/framework.exp (log_and_exit): Print collected Tcl errors.
+
+	* runtest.exp (dejagnu::error): New namespace.
+	(runtest): Collect Tcl errors caught while executing test scripts.
+
 2020-06-24  Jacob Bachmeyer  <jcb62281+dev@gmail.com>
 
 	PR 41824 / PR 41918
diff --git a/lib/framework.exp b/lib/framework.exp
index 0850595..9cfff9d 100644
--- a/lib/framework.exp
+++ b/lib/framework.exp
@@ -381,6 +381,15 @@ proc log_and_exit {} {
 	    warning "${tool}_version failed:\n$output"
 	}
     }
+    if {[llength $::dejagnu::error::list] > 0} {
+	# print errors again at end of output
+	foreach { cell } $::dejagnu::error::list {
+	    clone_output "ERROR: in testcase [lindex $cell 0]"
+	    clone_output "ERROR:  [lindex $cell 1]"
+	    clone_output "ERROR:  tcl error code [lindex $cell 2]"
+	    clone_output "ERROR:  tcl error info:\n[lindex $cell 3]"
+	}
+    }
     close_logs
     verbose -log "runtest completed at [timestamp -format %c]"
     if {$mail_logs} {
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 }
 	}