diff options
author | twylite <twylite@crypt.co.za> | 2012-08-03 16:39:49 (GMT) |
---|---|---|
committer | twylite <twylite@crypt.co.za> | 2012-08-03 16:39:49 (GMT) |
commit | 79878e7af5ae502d353130a4cca867147152bfc2 (patch) | |
tree | 6d4e5f813c3379eb7aebf2fa65aaf0e7fe13dbd3 /generic/tclExecute.c | |
parent | 94af10e431bdb850d1bb4352c03153b1f78015b8 (diff) | |
download | tcl-79878e7af5ae502d353130a4cca867147152bfc2.zip tcl-79878e7af5ae502d353130a4cca867147152bfc2.tar.gz tcl-79878e7af5ae502d353130a4cca867147152bfc2.tar.bz2 |
[Patch-3163961] Implementation of TIP #405 merged from private branch. Includes 'mapeach', 'dict map' and 'foreacha' commands, test suite (partial for 'foreacha') and man pages (except for 'foreacha').
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r-- | generic/tclExecute.c | 17 |
1 files changed, 14 insertions, 3 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index e402634..952eb32 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5492,7 +5492,15 @@ TEBCresume( opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp)); goto gotError; } - if (listLen > iterNum * numVars) { + + /* If the accumulator is the only variable then this list gets + * just one iteration. Otherwise we must keep going until the + * list is exhausted by non-accumulator loop vars */ + j = ((i == 0) && (iterNum > 0) + && (infoPtr->collect == TCL_EACH_ACCUM)); + /* j is 1 if the accumulator is present but does not consume + * an element, or 0 otherwise (consuming or not-present). */ + if ((numVars > j) && (listLen > (iterNum * (numVars - j) + j))) { continueLoop = 1; } listTmpIndex++; @@ -5517,8 +5525,11 @@ TEBCresume( listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); TclListObjGetElements(interp, listPtr, &listLen, &elements); - valIndex = (iterNum * numVars); - for (j = 0; j < numVars; j++) { + /* Don't modify the accumulator except on the first iteration */ + j = ((i == 0) && (iterNum > 0) + && (infoPtr->collect == TCL_EACH_ACCUM)); + valIndex = (iterNum * (numVars - j) + j); + for (; j < numVars; j++) { if (valIndex >= listLen) { TclNewObj(valuePtr); } else { |