Browse Source

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

farm
Jacob Bachmeyer 6 years ago
parent
commit
2c7ae2526b
  1. 9
      ChangeLog
  2. 9
      lib/framework.exp
  3. 18
      runtest.exp

9
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

9
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} {

18
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 }
}

Loading…
Cancel
Save