From c4c7df6e176c32ac510fc6e454147a478ffc4cf1 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 26 Jun 2017 17:30:15 +0000 Subject: Test demonstrating autoloader fragility. --- tests/init.test | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/init.test b/tests/init.test index 41b8624..3a5197a 100644 --- a/tests/init.test +++ b/tests/init.test @@ -168,6 +168,16 @@ foreach arg [subst -nocommands -novariables { incr count } +test init-4.$count {[Bug 46f801ed5a]} -setup { + auto_reset + array set auto_index {demo {proc demo {} {tailcall error foo}}} +} -body { + demo +} -cleanup { + array unset auto_index demo + rename demo {} +} -match glob -result * + test init-5.0 {return options passed through ::unknown} -setup { catch {rename xxx {}} set ::auto_index(::xxx) {proc ::xxx {} { -- cgit v0.12 From 45b7c8a7643c1ccb4268653e962709300c237d85 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 26 Jun 2017 19:17:12 +0000 Subject: Try to make good stack trace. Fallback to making not-so-good stack trace. Stop failing altogether. Test in test suite, not program fragility. --- library/init.tcl | 50 ++++++++++++++++++++++++++++---------------------- tests/init.test | 2 +- 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 {}} -- cgit v0.12 From 2223757a3583e4541ae5814fc6e7059e6048e480 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 26 Jun 2017 19:37:34 +0000 Subject: Bump to TclOO 1.1.0 --- generic/tclOO.h | 2 +- unix/tclooConfig.sh | 2 +- win/tclooConfig.sh | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclOO.h b/generic/tclOO.h index 46f01fb..32afbf1 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -24,7 +24,7 @@ * win/tclooConfig.sh */ -#define TCLOO_VERSION "1.0.5" +#define TCLOO_VERSION "1.1.0" #define TCLOO_PATCHLEVEL TCLOO_VERSION #include "tcl.h" diff --git a/unix/tclooConfig.sh b/unix/tclooConfig.sh index ee10b81..2279542 100644 --- a/unix/tclooConfig.sh +++ b/unix/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS="" -TCLOO_VERSION=1.0.4 +TCLOO_VERSION=1.1.0 diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh index ee10b81..2279542 100644 --- a/win/tclooConfig.sh +++ b/win/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS="" -TCLOO_VERSION=1.0.4 +TCLOO_VERSION=1.1.0 -- cgit v0.12