summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2001-04-06 17:57:31 (GMT)
committerdgp <dgp@users.sourceforge.net>2001-04-06 17:57:31 (GMT)
commitb80daf1c9480cf551e21ac7661392ed5b0b621ff (patch)
treeffdfebd57f01286746bfa763f6d46898e39374fd /library
parentdb1db9eb0cc87f32ea08f460c71eac8b6bc1034f (diff)
downloadtcl-b80daf1c9480cf551e21ac7661392ed5b0b621ff.zip
tcl-b80daf1c9480cf551e21ac7661392ed5b0b621ff.tar.gz
tcl-b80daf1c9480cf551e21ac7661392ed5b0b621ff.tar.bz2
Modified processing of $::errorInfo by [unknown] when the auto-loaded command
throws an error to better cover the tracks of auto-loading. [Bug 219280, Patch 403551]
Diffstat (limited to 'library')
-rw-r--r--library/init.tcl48
1 files changed, 41 insertions, 7 deletions
diff --git a/library/init.tcl b/library/init.tcl
index b6ba69f..644fba3 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
# Default system startup file for Tcl-based applications. Defines
# "unknown" procedure and auto-load facilities.
#
-# RCS: @(#) $Id: init.tcl,v 1.44 2000/12/11 04:17:38 dgp Exp $
+# RCS: @(#) $Id: init.tcl,v 1.45 2001/04/06 17:57:31 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -203,14 +203,48 @@ proc unknown args {
set code [catch {uplevel 1 $args} msg]
if {$code == 1} {
#
- # Strip the last five lines off the error stack (they're
- # from the "uplevel" command).
+ # Compute stack trace contribution from the [uplevel].
+ # Note the dependence on how Tcl_AddErrorInfo, etc.
+ # construct the stack trace.
#
-
- set new [split $errorInfo \n]
- set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \n]
+ set cinfo $args
+ if {[string length $cinfo] > 150} {
+ set cinfo "[string range $cinfo 0 149]..."
+ }
+ append cinfo "\"\n (\"uplevel\" body line 1)"
+ append cinfo "\n invoked from within"
+ append cinfo "\n\"uplevel 1 \$args\""
+ #
+ # Try each possible form of the stack trace
+ # and trim the extra contribution from the matching case
+ #
+ set expect "$msg\n while executing\n\"$cinfo"
+ if {$errorInfo eq $expect} {
+ #
+ # The stack has only the eval from the expanded command
+ # Do not generate any stack trace here.
+ #
+ return -code error -errorcode $errorCode $msg
+ }
+ #
+ # Stack trace is nested, trim off just the contribution
+ # from the extra "eval" of $args due to the "catch" above.
+ #
+ set expect "\n invoked from within\n\"$cinfo"
+ set exlen [string length $expect]
+ set eilen [string length $errorInfo]
+ set i [expr {$eilen - $exlen - 1}]
+ set einfo [string range $errorInfo 0 $i]
+ #
+ # For now verify that $errorInfo consists of what we are about
+ # to return plus what we expected to trim off.
+ #
+ if {$errorInfo ne "$einfo$expect"} {
+ error "Tcl bug: unexpected stack trace in \"unknown\"" {} \
+ [list CORE UNKNOWN BADTRACE $expect $errorInfo"]
+ }
return -code error -errorcode $errorCode \
- -errorinfo $new $msg
+ -errorinfo $einfo $msg
} else {
return -code $code $msg
}