diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 25 | ||||
| -rw-r--r-- | tests/compile.test | 12 |
3 files changed, 37 insertions, 6 deletions
@@ -1,3 +1,9 @@ +2001-08-21 Miguel Sofer <msofer@users.sourceforge.net> + + * generic/tclCompCmds.c: + * tests/compile.test: Fixed overagressive compilation of [catch]: + it was catching errors at substitution time. [Bug #219184] + 2001-08-21 Jeff Hobbs <jeffh@ActiveState.com> * tests/tcltest.test (tcltest-12.2): fixed test that would break diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 74ba524..a61f962 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.9 2001/06/28 00:42:39 hobbs Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.10 2001/08/22 13:57:53 msofer Exp $ */ #include "tclInt.h" @@ -317,10 +317,27 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr); - startOffset = (envPtr->codeNext - envPtr->codeStart); + /* + * If the body is a simple word, compile the instructions to + * eval it. Otherwise, compile instructions to substitute its + * text without catching, a catch instruction that resets the + * stack to what it was before substituting the body, and then + * an instruction to eval the body. Care has to be taken to + * register the correct startOffset for the catch range so that + * errors in the substitution are not catched [Bug 219184] + */ + + if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { + startOffset = (envPtr->codeNext - envPtr->codeStart); + code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr); + } else { + code = TclCompileTokens(interp, cmdTokenPtr+1, + cmdTokenPtr->numComponents, envPtr); + startOffset = (envPtr->codeNext - envPtr->codeStart); + TclEmitOpcode(INST_EVAL_STK, envPtr); + } envPtr->exceptArrayPtr[range].codeOffset = startOffset; - code = TclCompileCmdWord(interp, cmdTokenPtr+1, - cmdTokenPtr->numComponents, envPtr); + if (code != TCL_OK) { if (code == TCL_ERROR) { sprintf(buffer, "\n (\"catch\" body line %d)", diff --git a/tests/compile.test b/tests/compile.test index 7a26031..2a8d6b8 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -1,4 +1,4 @@ -# This file contains tests for the file tclCompile.c. +# This file contains tests for the files tclCompile.c and tclCompCmds.c # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compile.test,v 1.9 2000/05/03 00:14:36 hobbs Exp $ +# RCS: @(#) $Id: compile.test,v 1.10 2001/08/22 13:57:53 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -89,6 +89,14 @@ test compile-3.2 {TclCompileCatchCmd: non-local variables} { catch-test set ::foo } 3 +test compile-3.3 {TclCompileCatchCmd: overagressive compiling [bug 219184]} { + proc catch-test {str} { + catch [eval $str GOOD] + error BAD + } + catch {catch-test error} ::foo + set ::foo +} {GOOD} test compile-4.1 {TclCompileForCmd: command substituted test expression} { set i 0 |