summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-01-11 14:04:33 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-01-11 14:04:33 (GMT)
commitb1cd450bf53330939e3b7515f282a29383c347a2 (patch)
tree009b2951d6b35992b3b390051eb33290841f333d
parente89dea9b9b819e7b5ddc8d171127b749e237af35 (diff)
downloadtcl-b1cd450bf53330939e3b7515f282a29383c347a2.zip
tcl-b1cd450bf53330939e3b7515f282a29383c347a2.tar.gz
tcl-b1cd450bf53330939e3b7515f282a29383c347a2.tar.bz2
First attempt at fixing problems caused by [array set] inside [namespace eval],
which caused partial bytecode generation followed by a reject which triggered the issuing of generic ensemble code with an extra push of the variable name at the start (which got the stack depth wrong).
-rw-r--r--generic/tclCompCmds.c21
-rw-r--r--generic/tclEnsemble.c14
2 files changed, 29 insertions, 6 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 752db93..503f339 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -107,6 +107,7 @@ static int CompileDictEachCmd(Tcl_Interp *interp,
*/
#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
+#define TCL_NO_ELEMENT 2 /* Do not push the array element. */
/*
* The structures below define the AuxData types defined in this file.
@@ -259,7 +260,7 @@ TclCompileArrayExistsCmd(
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarNameWord(interp, tokenPtr, envPtr, 0,
+ PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
&localIndex, &simpleVarName, &isScalar, 1);
if (!isScalar) {
return TCL_ERROR;
@@ -294,7 +295,14 @@ TclCompileArraySetCmd(
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarNameWord(interp, tokenPtr, envPtr, 0,
+ if (envPtr->procPtr == NULL) {
+ Tcl_Token *tokPtr = TokenAfter(tokenPtr);
+
+ if (tokPtr->type != TCL_TOKEN_SIMPLE_WORD || tokPtr[1].size != 0) {
+ return TCL_ERROR;
+ }
+ }
+ PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
&localIndex, &simpleVarName, &isScalar, 1);
if (!isScalar) {
return TCL_ERROR;
@@ -437,7 +445,7 @@ TclCompileArrayUnsetCmd(
return TCL_ERROR;
}
- PushVarNameWord(interp, tokenPtr, envPtr, 0,
+ PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
&localIndex, &simpleVarName, &isScalar, 1);
if (!isScalar) {
return TCL_ERROR;
@@ -6006,7 +6014,7 @@ PushVarName(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Token *varTokenPtr, /* Points to a variable token. */
CompileEnv *envPtr, /* Holds resulting instructions. */
- int flags, /* TCL_NO_LARGE_INDEX. */
+ int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
int *localIndexPtr, /* Must not be NULL. */
int *simpleVarNamePtr, /* Must not be NULL. */
int *isScalarPtr, /* Must not be NULL. */
@@ -6187,10 +6195,11 @@ PushVarName(
}
/*
- * Compile the element script, if any.
+ * Compile the element script, if any, and only if not inhibited. [Bug
+ * 3600328]
*/
- if (elName != NULL) {
+ if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
if (elNameChars) {
envPtr->line = line;
envPtr->clNext = clNext;
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 2753876..835c9ad 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3056,6 +3056,9 @@ CompileToCompiledCommand(
Tcl_Parse synthetic;
Tcl_Token *tokenPtr;
int result, i;
+ int savedNumCmds = envPtr->numCommands;
+ int savedStackDepth = envPtr->currStackDepth;
+ unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
if (cmdPtr->compileProc == NULL) {
return TCL_ERROR;
@@ -3110,6 +3113,17 @@ CompileToCompiledCommand(
result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr);
/*
+ * If our target fails to compile, revert the number of commands and the
+ * pointer to the place to issue the next instruction. [Bug 3600328]
+ */
+
+ if (result != TCL_OK) {
+ envPtr->numCommands = savedNumCmds;
+ envPtr->currStackDepth = savedStackDepth;
+ envPtr->codeNext = envPtr->codeStart + savedCodeNext;
+ }
+
+ /*
* Clean up if necessary.
*/