From 3073801f15238627be21f713862787d8a5248c21 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 18 Dec 2014 21:08:53 +0000
Subject: Replace use of TclIsLocalScalar() and late setting of varIndexes with
 an earlier setting of varIndexes using PushVarNameWord().

---
 generic/tclCompCmds.c | 44 +++++++++++++++++++++++++++++---------------
 1 file 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]);
-- 
cgit v0.12