--- /opt/net/lib/tcl8.1/init.tcl Tue Sep 8 16:42:21 1998 +++ init.tcl Tue May 4 15:56:12 1999 @@ -169,19 +169,51 @@ if {$msg} { set errorCode $savedErrorCode set errorInfo $savedErrorInfo - set code [catch {uplevel 1 $args} msg] + namespace eval ::tcl {variable __tmpmsg ""} + upvar 0 ::tcl::__tmpmsg tmpmsg + set code [uplevel 1 [list catch $args ::tcl::__tmpmsg]] if {$code == 1} { # - # Strip the last five lines off the error stack (they're - # from the "uplevel" command). + # Compute stack trace contribution from the "eval" (catch) + # of $args # - - 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]..." + } + # + # Try each possible form of the stack trace + # and trim the extra contribution from the matching case + # + set expect "$tmpmsg\n while executing\n\"$cinfo\"" + if {[string compare $errorInfo $expect] == 0} { + # + # The stack has only the eval from the expanded command + # Do not generate any stack trace here. + # + return -code error -errorcode $errorCode $tmpmsg + } + # + # 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 {[string compare $errorInfo "$einfo$expect"] != 0} { + error "Tcl bug: unexpected stack trace in \"unknown\"" {} \ + [list CORE UNKNOWN BADTRACE $expect $errorInfo"] + } return -code error -errorcode $errorCode \ - -errorinfo $new $msg + -errorinfo $einfo $tmpmsg } else { - return -code $code $msg + return -code $code $::tcl::__tmpmsg } } }