Merge branch 'PR41918'

Conflicts:
	ChangeLog

1 files changed, 48 insertions, 12 deletions

diff --git a/lib/framework.exp b/lib/framework.exp
index 6d7cf4d..24afbed 100644
--- a/lib/framework.exp
+++ b/lib/framework.exp
@@ -310,21 +310,46 @@ proc isnative { } {
 # This allows Tcl package autoloading to work in the modern age.
 
 rename ::unknown ::tcl_unknown
-proc unknown args {
-    if {[catch {uplevel 1 ::tcl_unknown $args} msg]} {
-	global errorCode
-	global errorInfo
-	global exit_status
+proc unknown { args } {
+    global errorCode
+    global errorInfo
+    global exit_status
+
+    set code [catch {uplevel 1 ::tcl_unknown $args} msg]
+    if { $code != 0 } {
+	set ret_cmd [list return -code $code]
 
-	clone_output "ERROR: (DejaGnu) proc \"$args\" does not exist."
-	if {[info exists errorCode]} {
-	    send_error "The error code is $errorCode\n"
+	# If the command now exists, then it was autoloaded.  We are here,
+	# therefore invoking the autoloaded command raised an error.
+	# Silently propagate errors from autoloaded procedures, but
+	# complain noisily about undefined commands.
+	set have_it_now [llength [info commands [lindex $args 0]]]
+
+	if { ! $have_it_now } {
+	    clone_output "ERROR: (DejaGnu) proc \"$args\" does not exist."
+	    set exit_status 2
 	}
-	if {[info exists errorInfo]} {
-	    send_error "The info on the error is:\n$errorInfo\n"
+
+	if { [info exists errorCode] } {
+	    lappend ret_cmd -errorcode $errorCode
+	    if { ! $have_it_now } {
+		send_error "The error code is $errorCode\n"
+	    }
 	}
-	set exit_status 2
-	log_and_exit
+	if { [info exists errorInfo] } {
+	    # omitting errorInfo from the propagated error makes this proc
+	    # invisible with the backtrace pointing directly to the problem
+	    if { ! $have_it_now } {
+		send_error "The info on the error is:\n$errorInfo\n"
+	    }
+	}
+
+	lappend ret_cmd $msg
+
+	eval $ret_cmd
+    } else {
+	# Propagate return value.
+	return $msg
     }
 }
 
@@ -409,6 +434,17 @@ 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: [string repeat - 43]"
+	    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]\n[string repeat - 50]"
+	}
+    }
     close_logs
     verbose -log "runtest completed at [timestamp -format %c]"
     if {$mail_logs} {