diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclExecute.c | 12 | ||||
| -rw-r--r-- | tests/execute.test | 23 |
3 files changed, 40 insertions, 2 deletions
@@ -1,3 +1,10 @@ +2008-08-04 Don Porter <dgp@users.sourceforge.net>S + + * generic/tclExecute.c: Stopped faulty double-logging of errors to + * tests/execute.test: stack trace when a compile epoch bump triggers + fallback to direct evaluation of commands in a compiled script. + [Bug 2037338] + 2008-08-03 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c: new unsupported command atProcExit diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 3f8f4a7..360525e 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.394 2008/08/03 17:33:10 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.395 2008/08/04 04:49:24 dgp Exp $ */ #include "tclInt.h" @@ -2294,6 +2294,16 @@ TclExecuteByteCode( CACHE_STACK_INFO(); if (result != TCL_OK) { cleanup = 0; + if (result == TCL_ERROR) { + /* + * Tcl_EvalEx already did the task of logging + * the error to the stack trace for us, so set + * a flag to prevent the TEBC exception handling + * machinery from trying to do it again. + * Tcl Bug 2037338. See test execute-8.4. + */ + iPtr->flags |= ERR_ALREADY_LOGGED; + } goto processExceptionReturn; } opnd = TclGetUInt4AtPtr(pc+1); diff --git a/tests/execute.test b/tests/execute.test index a43e8e6..6c34dc1 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: execute.test,v 1.27 2008/03/07 19:04:10 dgp Exp $ +# RCS: @(#) $Id: execute.test,v 1.28 2008/08/04 04:49:24 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -937,6 +937,27 @@ test execute-8.3 {Stack restoration} -body { interp recursionlimit {} $limit } -result {too many nested evaluations (infinite loop?)} +test execute-8.4 {Compile epoch bump effect on stack trace} -setup { + proc foo {} { + error bar + } + proc FOO {} { + catch {error bar} m o + rename ::set ::dummy + rename ::dummy ::set + return -options $o $m + } +} -body { + catch foo m o + set stack1 [dict get $o -errorinfo] + catch FOO m o + set stack2 [string map {FOO foo} [dict get $o -errorinfo]] + expr {$stack1 eq $stack2 ? {} : "These differ:\n$stack1\n$stack2"} +} -cleanup { + rename foo {} + rename FOO {} +} -result {} + test execute-9.1 {Interp result resetting [Bug 1522803]} { set c 0 catch { |