diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | generic/tclExecute.c | 19 | ||||
| -rw-r--r-- | tests/foreach.test | 14 |
3 files changed, 30 insertions, 7 deletions
@@ -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} |