summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-03-13 16:26:31 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-03-13 16:26:31 (GMT)
commit76a2ced0a1bab38668ad8bbf071794a9e437ed18 (patch)
tree1156a6ef53e1ff3c861e47696b776b8b7284c681 /generic
parenta3ba8079a4c6747f3fd58413e35cd0e2d3adee3d (diff)
downloadtcl-76a2ced0a1bab38668ad8bbf071794a9e437ed18.zip
tcl-76a2ced0a1bab38668ad8bbf071794a9e437ed18.tar.gz
tcl-76a2ced0a1bab38668ad8bbf071794a9e437ed18.tar.bz2
* generic/tclExecute.c (INST_FOREACH_STEP4): Re-fetch pointers for
* tests/foreach.test (foreach-10.1): the value list each iteration of the loop as defense against shimmers. [Bug 1671087]
Diffstat (limited to 'generic')
-rw-r--r--generic/tclExecute.c19
1 files changed, 13 insertions, 6 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 59412b8..4fd6dcc 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.94.2.20 2006/11/28 22:20:00 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.94.2.21 2007/03/13 16:26:32 dgp Exp $
*/
#include "tclInt.h"
@@ -4052,7 +4052,6 @@ TclExecuteByteCode(interp, codePtr)
int numLists = infoPtr->numLists;
Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
Tcl_Obj *listPtr;
- List *listRepPtr;
Var *iterVarPtr, *listVarPtr;
int iterNum, listTmpIndex, listLen, numVars;
int varIndex, valIndex, continueLoop, j;
@@ -4106,15 +4105,23 @@ TclExecuteByteCode(interp, codePtr)
listVarPtr = &(compiledLocals[listTmpIndex]);
listPtr = listVarPtr->value.objPtr;
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
- listLen = listRepPtr->elemCount;
-
+
valIndex = (iterNum * numVars);
for (j = 0; j < numVars; j++) {
+ Tcl_Obj **elements;
+
+ /*
+ * The call to TclPtrSetVar might shimmer listPtr,
+ * so re-fetch pointers every iteration for safety.
+ * See test foreach-10.1.
+ */
+
+ Tcl_ListObjGetElements(NULL, listPtr,
+ &listLen, &elements);
if (valIndex >= listLen) {
TclNewObj(valuePtr);
} else {
- valuePtr = listRepPtr->elements[valIndex];
+ valuePtr = elements[valIndex];
}
varIndex = varListPtr->varIndexes[j];