summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclExecute.c19
-rw-r--r--tests/foreach.test14
3 files changed, 30 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index 253c4e7..e76ab9e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2007-03-13 Don Porter <dgp@users.sourceforge.net>
+ * 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]
+
* generic/tclVar.c (TclArraySet): Re-fetch pointers for the list
* tests/var.test (var-17.1): argument of [array set] each time
through the loop as defense against possible shimmer issues.
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];
diff --git a/tests/foreach.test b/tests/foreach.test
index ee90ce2..a260576 100644
--- a/tests/foreach.test
+++ b/tests/foreach.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: foreach.test,v 1.8.8.2 2007/03/01 10:16:10 dkf Exp $
+# RCS: @(#) $Id: foreach.test,v 1.8.8.3 2007/03/13 16:26:33 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -243,6 +243,18 @@ test foreach-9.1 {compiled empty var list} {
list [catch { foo } msg] $msg
} {1 {foreach varlist is empty}}
+test foreach-10.1 {foreach: [Bug 1671087]} -setup {
+ proc demo {} {
+ set vals {1 2 3 4}
+ trace add variable x write {string length $vals ;# }
+ foreach {x y} $vals {format $y}
+ }
+} -body {
+ demo
+} -cleanup {
+ rename demo {}
+} -result {}
+
# cleanup
catch {unset a}
catch {unset x}