summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog10
-rw-r--r--generic/tclCompCmds.c23
-rw-r--r--generic/tclCompile.c4
-rw-r--r--generic/tclCompile.h6
-rw-r--r--generic/tclExecute.c4
-rw-r--r--tests/compile.test4
6 files changed, 24 insertions, 27 deletions
diff --git a/ChangeLog b/ChangeLog
index a245767..3b1a388 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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]