summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--library/init.tcl50
-rw-r--r--tests/init.test2
2 files changed, 29 insertions, 23 deletions
diff --git a/library/init.tcl b/library/init.tcl
index a202054..6173b86 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -284,14 +284,9 @@ proc unknown args {
}
append cinfo ...
}
- 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"
+ set tail "\n (\"uplevel\" body line 1)\n invoked\
+ from within\n\"uplevel 1 \$args\""
+ set expect "$msg\n while executing\n\"$cinfo\"$tail"
if {$errInfo eq $expect} {
#
# The stack has only the eval from the expanded command
@@ -305,21 +300,32 @@ proc unknown args {
# 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 $errInfo]
- set i [expr {$eilen - $exlen - 1}]
- set einfo [string range $errInfo 0 $i]
- #
- # For now verify that $errInfo consists of what we are about
- # to return plus what we expected to trim off.
- #
- if {$errInfo ne "$einfo$expect"} {
- error "Tcl bug: unexpected stack trace in \"unknown\"" {} \
- [list CORE UNKNOWN BADTRACE $einfo $expect $errInfo]
+ set last [string last $tail $errInfo]
+ if {$last + [string length $tail] != [string length $errInfo]} {
+ # Very likely cannot happen
+ return -options $opts $msg
}
- return -code error -errorcode $errCode \
- -errorinfo $einfo $msg
+ set errInfo [string range $errInfo 0 $last-1]
+ set tail "\"$cinfo\""
+ set last [string last $tail $errInfo]
+ if {$last + [string length $tail] != [string length $errInfo]} {
+ return -code error -errorcode $errCode \
+ -errorinfo $errInfo $msg
+ }
+ set errInfo [string range $errInfo 0 $last-1]
+ set tail "\n invoked from within\n"
+ set last [string last $tail $errInfo]
+ if {$last + [string length $tail] == [string length $errInfo]} {
+ return -code error -errorcode $errCode \
+ -errorinfo [string range $errInfo 0 $last-1] $msg
+ }
+ set tail "\n while executing\n"
+ set last [string last $tail $errInfo]
+ if {$last + [string length $tail] == [string length $errInfo]} {
+ return -code error -errorcode $errCode \
+ -errorinfo [string range $errInfo 0 $last-1] $msg
+ }
+ return -options $opts $msg
} else {
dict incr opts -level
return -options $opts $msg
diff --git a/tests/init.test b/tests/init.test
index 3a5197a..639389f 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -176,7 +176,7 @@ test init-4.$count {[Bug 46f801ed5a]} -setup {
} -cleanup {
array unset auto_index demo
rename demo {}
-} -match glob -result *
+} -returnCodes error -result foo
test init-5.0 {return options passed through ::unknown} -setup {
catch {rename xxx {}}