summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2014-12-18 21:08:53 (GMT)
committerdgp <dgp@users.sourceforge.net>2014-12-18 21:08:53 (GMT)
commit3073801f15238627be21f713862787d8a5248c21 (patch)
tree5466f6a1b42d8c9e06ba0c09df44db5c498bcc24 /generic/tclCompCmds.c
parent748fa3a11436f305210af6a3e39d41222c25d704 (diff)
downloadtcl-3073801f15238627be21f713862787d8a5248c21.zip
tcl-3073801f15238627be21f713862787d8a5248c21.tar.gz
tcl-3073801f15238627be21f713862787d8a5248c21.tar.bz2
Replace use of TclIsLocalScalar() and late setting of varIndexes with an
earlier setting of varIndexes using PushVarNameWord().
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c44
1 files changed, 29 insertions, 15 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index d2d14f0..bae1fd1 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1545,6 +1545,7 @@ TclCompileForeachCmd(
int jumpBackDist, jumpBackOffset, infoIndex, range;
int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
int savedStackDepth = envPtr->currStackDepth;
+ Tcl_Obj *varListObj = NULL;
DefineLineInformation; /* TIP #280 */
/*
@@ -1607,6 +1608,7 @@ TclCompileForeachCmd(
*/
loopIndex = 0;
+ varListObj = Tcl_NewObj();
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
@@ -1616,7 +1618,16 @@ TclCompileForeachCmd(
if (i%2 != 1) {
continue;
}
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+
+ /*
+ * If the variable list is empty, we can enter an infinite loop when
+ * the interpreted version would not. Take care to ensure this does
+ * not happen. [Bug 1671138]
+ */
+
+ if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
+ TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
+ numVars == 0) {
code = TCL_ERROR;
goto done;
}
@@ -1642,25 +1653,23 @@ TclCompileForeachCmd(
infoPtr->varLists[loopIndex] = varListPtr;
infoPtr->numLists++;
- /*
- * If the variable list is empty, we can enter an infinite loop when
- * the interpreted version would not. Take care to ensure this does
- * not happen. [Bug 1671138]
- */
-
- if (numVars == 0) {
- code = TCL_ERROR;
- goto done;
- }
-
for (j = 0; j < numVars; j++) {
- const char *varName = varvList[loopIndex][j];
-
- if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
+ Tcl_Obj *varNameObj;
+ Tcl_Token token;
+ int varIndex, isSimple, isScalar;
+
+ Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
+ token.start = Tcl_GetStringFromObj(varNameObj, &token.size);
+ PushVarNameWord(interp, &token, envPtr, TCL_CREATE_VAR,
+ &varIndex, &isSimple, &isScalar, 0 /* ignored */);
+ if (!isScalar || varIndex < 0) {
code = TCL_ERROR;
goto done;
}
+ varListPtr->varIndexes[j] = varIndex;
}
+
+ Tcl_SetObjLength(varListObj, 0);
loopIndex++;
}
@@ -1683,6 +1692,7 @@ TclCompileForeachCmd(
}
infoPtr->loopCtTemp = TclFindCompiledLocal(NULL, 0, 1, procPtr);
+#if 0
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
ForeachVarList *varListPtr = infoPtr->varLists[loopIndex];
numVars = varListPtr->numVars;
@@ -1694,6 +1704,7 @@ TclCompileForeachCmd(
nameChars, /*create*/ 1, procPtr);
}
}
+#endif
infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
/*
@@ -1810,6 +1821,9 @@ TclCompileForeachCmd(
FreeForeachInfo(infoPtr);
}
}
+ if (varListObj) {
+ Tcl_DecrRefCount(varListObj);
+ }
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
if (varvList[loopIndex] != NULL) {
ckfree((char *) varvList[loopIndex]);