summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclCompCmds.c21
-rw-r--r--generic/tclEnsemble.c14
3 files changed, 37 insertions, 6 deletions
diff --git a/ChangeLog b/ChangeLog
index 23cd2a5..e56d8df 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2013-01-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (PushVarName): [Bug 3600328]: Added mechanism
+ for suppressing compilation of variables when we couldn't cope with
+ the results. Useful for some [array] subcommands.
+ * generic/tclEnsemble.c (CompileToCompiledCommand): Must restore the
+ compilation environment when a command compiler fails.
+
2013-01-16 Donal K. Fellows <dkf@users.sf.net>
* generic/tclZlib.c (TclZlibInit): [Bug 3601086]: Register the config
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 058590a..88de9f3 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.
*/