diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 23 | ||||
| -rw-r--r-- | generic/tclCompile.c | 4 | ||||
| -rw-r--r-- | generic/tclCompile.h | 6 | ||||
| -rw-r--r-- | generic/tclExecute.c | 4 | ||||
| -rw-r--r-- | tests/compile.test | 4 |
6 files changed, 24 insertions, 27 deletions
@@ -1,3 +1,11 @@ +2003-03-19 Don Porter <dgp@users.sourceforge.net> + + * generic/tclCompCmds.c (TclCompileReturnCmd): Alternative fix for + * generic/tclCompile.c (INST_RETURN): [Bug 633204] that uses a new + * generic/tclCompile.h (INST_RETURN): bytecode INST_RETURN to + * generic/tclExecute.c (INST_RETURN): properly bytecode the + [return] command to something that returns TCL_RETURN. + 2003-03-18 Mo DeJong <mdejong@users.sourceforge.net> * win/configure: Regen. @@ -1120,7 +1128,7 @@ 2003-01-09 Don Porter <dgp@users.sourceforge.net> - * generic/tclCompCmds.c (TclCompilerReturnCmd): Corrected off-by-one + * generic/tclCompCmds.c (TclCompileReturnCmd): Corrected off-by-one problem with recent commit. [Bug 633204] 2003-01-09 Vince Darley <vincentdarley@users.sourceforge.net> diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 44f6109..fdd339b 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -11,7 +11,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.42 2003/03/13 02:48:52 dgp Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.43 2003/03/19 16:51:42 dgp Exp $ */ #include "tclInt.h" @@ -2371,7 +2371,6 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) { Tcl_Token *varTokenPtr; int code; - int index = envPtr->exceptArrayNext - 1; /* * If we're not in a procedure, don't compile. @@ -2381,22 +2380,6 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) return TCL_OUT_LINE_COMPILE; } - /* - * Look back through the ExceptionRanges of the current CompileEnv, - * from exceptArrayPtr[(exceptArrayNext - 1)] down to - * exceptArrayPtr[0] to see if any of them is an enclosing [catch]. - * If there's an enclosing [catch], don't compile. - */ - - while (index >= 0) { - ExceptionRange range = envPtr->exceptArrayPtr[index]; - if ((range.type == CATCH_EXCEPTION_RANGE) - && (range.catchOffset == -1)) { - return TCL_OUT_LINE_COMPILE; - } - index--; - } - switch (parsePtr->numWords) { case 1: { /* @@ -2448,11 +2431,11 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) } /* - * The INST_DONE opcode actually causes the branching out of the + * The INST_RETURN opcode triggers the branching out of the * subroutine, and takes the top stack item as the return result * (which is why we pushed the value above). */ - TclEmitOpcode(INST_DONE, envPtr); + TclEmitOpcode(INST_RETURN, envPtr); return TCL_OK; } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c98348f..6812331 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.44 2003/03/13 02:48:52 dgp Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.45 2003/03/19 16:51:42 dgp Exp $ */ #include "tclInt.h" @@ -269,6 +269,8 @@ InstructionDesc tclInstructionTable[] = { * stacked objs: stktop is old value, next is new element value, next * come (operand-2) indices; pushes the new value. */ + {"return", 1, -1, 0, {OPERAND_NONE}}, + /* return TCL_RETURN code. */ {0} }; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index bdd9ecc..993bfd4 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.35 2003/03/13 02:48:53 dgp Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.36 2003/03/19 16:51:42 dgp Exp $ */ #ifndef _TCLCOMPILATION @@ -522,8 +522,10 @@ typedef struct ByteCode { #define INST_LSET_LIST 96 #define INST_LSET_FLAT 97 +#define INST_RETURN 98 + /* The last opcode */ -#define LAST_INST_OPCODE 97 +#define LAST_INST_OPCODE 98 /* * Table describing the Tcl bytecode instructions: their name (for diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 2496126..40e211d 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,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.95 2003/03/13 02:48:53 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.96 2003/03/19 16:51:43 dgp Exp $ */ #include "tclInt.h" @@ -1224,6 +1224,8 @@ TclExecuteByteCode(interp, codePtr) iPtr->stats.instructionCount[*pc]++; #endif switch (*pc) { + case INST_RETURN: + result = TCL_RETURN; case INST_DONE: if (stackTop <= initStackTop) { stackTop--; diff --git a/tests/compile.test b/tests/compile.test index e31da81..6369313 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -11,7 +11,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.24 2003/01/08 00:34:59 dgp Exp $ +# RCS: @(#) $Id: compile.test,v 1.25 2003/03/19 16:51:43 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -331,7 +331,7 @@ test compile-14.1 {testing errors in element name; segfault?} {} { list $msg1 $msg2 } {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}} -# Next 4 tests cover Tcl Bug 633204 +# Tests compile-15.* cover Tcl Bug 633204 test compile-15.1 {proper TCL_RETURN code from [return]} { proc p {} {catch return} set result [p] |