? patch419528.txt ? patch451200.txt ? patch219184.txt Index: ChangeLog =================================================================== RCS file: /cvsroot/tcl/tcl/ChangeLog,v retrieving revision 1.528 diff -u -r1.528 ChangeLog --- ChangeLog 2001/08/22 01:29:18 1.528 +++ ChangeLog 2001/08/22 13:55:13 @@ -1,3 +1,9 @@ +2001-08-21 Miguel Sofer + + * 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 * tests/tcltest.test (tcltest-12.2): fixed test that would break Index: generic/tclCompCmds.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v retrieving revision 1.9 diff -u -r1.9 tclCompCmds.c --- generic/tclCompCmds.c 2001/06/28 00:42:39 1.9 +++ generic/tclCompCmds.c 2001/08/22 13:55:15 @@ -317,10 +317,27 @@ 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)", Index: tests/compile.test =================================================================== RCS file: /cvsroot/tcl/tcl/tests/compile.test,v retrieving revision 1.9 diff -u -r1.9 compile.test --- tests/compile.test 2000/05/03 00:14:36 1.9 +++ tests/compile.test 2001/08/22 13:55:15 @@ -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 @@ -89,6 +89,14 @@ 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