Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,18 +1,27 @@ +2013-06-05 Donal K. Fellows + + * generic/tclExecute.c (INST_EXPAND_DROP): [Bugs 2835313, 3614226]: + New opcode to allow resetting the stack to get rid of an expansion, + restoring the stack to a known state in the process. + * generic/tclCompile.c, generic/tclCompCmds.c: Adjusted the compilers + for [break] and [continue] to get stack cleanup right in the majority + of cases. + * tests/for.test (for-7.*): Set of tests for these evil cases. + 2013-06-04 Jan Nijtmans - * unix/tcl.m4: Eliminate NO_VIZ macro as current - zlib uses HAVE_HIDDEN in stead. One more last-moment - fix for FreeBSD by Pietro Cerutti + * unix/tcl.m4: Eliminate NO_VIZ macro as current zlib uses HAVE_HIDDEN + instead. One more last-moment fix for FreeBSD by Pietro Cerutti 2013-06-03 Miguel Sofer * generic/tclExecute.c: fix for perf bug detected by Kieran (https://groups.google.com/forum/?fromgroups#!topic/comp.lang.tcl/vfpI3bc-DkQ), diagnosed by dgp to be a close relative of [Bug 781585], which was fixed by commit [f46fb50cb3]. This bug was introduced by myself in - commit [cbfe055d8c]. + commit [cbfe055d8c]. 2013-06-03 Donal K. Fellows * generic/tclCompCmds.c (TclCompileBreakCmd, TclCompileContinueCmd): Added code to allow [break] and [continue] to be issued as a jump (in @@ -22,18 +31,18 @@ and [continue]. 2013-05-27 Harald Oehlmann * library/msgcat/msgcat.tcl: [Bug 3036566]: Also get locale from - registry key HCU\Control Panel\Desktop : PreferredUILanguages to - honor installed language packs on Vista+. + registry key HCU\Control Panel\Desktop : PreferredUILanguages to honor + installed language packs on Vista+. Bumped msgcat version to 1.5.2 2013-05-22 Andreas Kupries * tclCompile.c: Removed duplicate const qualifier causing the HP - native cc to error out. + native cc to error out. 2013-05-22 Donal K. Fellows * generic/tclUtf.c (TclUtfCasecmp): [Bug 3613609]: Replace problematic uses of strcasecmp with a proper UTF-8-aware version. Affects both @@ -91,14 +100,13 @@ binary incompatibility. 2013-04-30 Andreas Kupries * library/platform/platform.tcl (::platform::LibcVersion): - * library/platform/pkgIndex.tcl: Followup to the 2013-01-30 - change. The RE become too restrictive again. SuSe added a - timestamp after the version. Loosened up a bit. Bumped package - to version 1.0.12. + * library/platform/pkgIndex.tcl: Followup to the 2013-01-30 change. + The RE become too restrictive again. SuSe added a timestamp after the + version. Loosened up a bit. Bumped package to version 1.0.12. 2013-04-29 Donal K. Fellows * generic/tclCompCmds.c (TclCompileArraySetCmd): Generate better code when the list of things to set is a literal. @@ -113,30 +121,30 @@ exactly the same as TCL_WIDE_INT_IS_LONG 2013-04-19 Jan Nijtmans * generic/tclDecls.h: Implement many Tcl_*Var* functions and - Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp - their Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct. + Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp their + Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct. 2013-04-12 Jan Nijtmans * generic/tclDecls.h: Implement Tcl_Pkg* functions as (faster/stack-saving) macros around Tcl_Pkg*Ex functions. 2013-04-08 Don Porter - * generic/regc_color.c: [Bug 3610026] Stop crash when the number of - * generic/regerrs.h: "colors" in a regular expression overflows - * generic/regex.h: a short int. Thanks to Heikki Linnakangas - * generic/regguts.h: for the report and the patch. + * generic/regc_color.c: [Bug 3610026]: Stop crash when the number of + * generic/regerrs.h: "colors" in a regular expression overflows a + * generic/regex.h: short int. Thanks to Heikki Linnakangas for + * generic/regguts.h: the report and the patch. * tests/regexp.test: 2013-04-04 Reinhard Max - * library/http/http.tcl (http::geturl): Allow URLs that don't have - a path, but a query query, e.g. http://example.com?foo=bar . + * library/http/http.tcl (http::geturl): Allow URLs that don't have a + path, but a query query, e.g. http://example.com?foo=bar * Bump the http package to 2.8.7. 2013-03-22 Venkat Iyer * library/tzdata/Africa/Cairo: Update to tzdata2013b. * library/tzdata/Africa/Casablanca: @@ -164,16 +172,16 @@ * library/tzdata/Asia/Ust-Nera: (new) * library/tzdata/Europe/Busingen: (new) 2013-03-21 Don Porter - * library/auto.tcl: [Bug 2102614] Add ensemble indexing support - * tests/autoMkindex.test: to [auto_mkindex]. Thanks Brian Griffin. + * library/auto.tcl: [Bug 2102614]: Add ensemble indexing support to + * tests/autoMkindex.test: [auto_mkindex]. Thanks Brian Griffin. 2013-03-19 Don Porter - * generic/tclFCmd.c: [Bug 3597000] Consistent [file copy] result. + * generic/tclFCmd.c: [Bug 3597000]: Consistent [file copy] result. * tests/fileSystem.test: 2013-03-19 Jan Nijtmans * win/tclWinFile.c: [Bug 3608360]: Incompatible behaviour of "file @@ -189,24 +197,24 @@ * unix/tcl.m4: Patch by Andrew Shadura, providing better support for three architectures they have in Debian. 2013-03-11 Don Porter - * generic/tclCompile.c: [Bugs 3607246,3607372] Unbalanced refcounts + * generic/tclCompile.c: [Bugs 3607246,3607372]: Unbalanced refcounts * generic/tclLiteral.c: of literals in the global literal table. 2013-03-06 Don Porter - * generic/regc_nfa.c: [Bugs 3604074,3606683] Rewrite of the - * generic/regcomp.c: fixempties() routine (and supporting - routines) to completely eliminate the infinite loop hazard. - Thanks to Tom Lane for the much improved solution. + * generic/regc_nfa.c: [Bugs 3604074,3606683]: Rewrite of the + * generic/regcomp.c: fixempties() routine (and supporting routines) + to completely eliminate the infinite loop hazard. Thanks to Tom Lane + for the much improved solution. 2013-02-28 Don Porter - * generic/tclLiteral.c: Revise TclReleaseLiteral() to tolerate a - NULL interp argument. + * generic/tclLiteral.c: Revise TclReleaseLiteral() to tolerate a NULL + interp argument. * generic/tclCompile.c: Update callers and revise mistaken comments. * generic/tclProc.c: 2013-02-27 Jan Nijtmans @@ -4897,12 +4905,11 @@ * generic/tclStrToD.c: [Bug 3005233]: Fix for build on OpenBSD vax 2010-05-19 Alexandre Ferrieux * tests/dict.test: Add missing tests for [Bug 3004007], fixed under - the radar on 2010-02-24 (dkf): EIAS violation in - list-dict conversions. + the radar on 2010-02-24 (dkf): EIAS violation in list-dict conversions 2010-05-19 Jan Nijtmans * generic/regcomp.c: Don't use arrays of length 1, just use a * generic/tclFileName.c: single element then, it makes code more @@ -6752,14 +6759,13 @@ * unix/Makefile.in: * win/Makefile.in: 2009-11-11 Alexandre Ferrieux - * generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error) - by saving the errno from the first of two - FlushChannel()s. Uneasy to test; might need - specific channel drivers. Four-hands with aku. + * generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error) by + saving the errno from the first of two FlushChannel()s. Uneasy to + test; might need specific channel drivers. Four-hands with aku. 2009-11-10 Pat Thoyts * tests/winFCmd.test: Cleanup directories that have been set chmod 000. On Windows7 and Vista we really have no access and these were Index: generic/tclAssembly.c ================================================================== --- generic/tclAssembly.c +++ generic/tclAssembly.c @@ -18,11 +18,11 @@ *- More instructions: *- done - alternate exit point (affects stack and exception range checking) *- break and continue - if exception ranges can be sorted out. *- foreach_start4, foreach_step4 *- returnImm, returnStk - *- expandStart, expandStkTop, invokeExpanded + *- expandStart, expandStkTop, invokeExpanded, expandDrop *- dictFirst, dictNext, dictDone *- dictUpdateStart, dictUpdateEnd *- jumpTable testing *- syntax (?) *- returnCodeBranch Index: generic/tclCompCmds.c ================================================================== --- generic/tclCompCmds.c +++ generic/tclCompCmds.c @@ -491,46 +491,28 @@ * Find the innermost exception range that contains this command. */ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxPtr); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { - int toPop = envPtr->currStackDepth - auxPtr->stackDepth; - - /* - * Pop off the extra stack frames. - */ - - while (toPop > 0) { - TclEmitOpcode(INST_POP, envPtr); - TclAdjustStackDepth(1, envPtr); - toPop--; - } - - if (envPtr->expandCount == auxPtr->expandTarget) { - /* - * Found the target! Also, no built-up expansion stack. No need - * for a nasty INST_BREAK here. - */ - - TclAddLoopBreakFixup(envPtr, auxPtr); - goto done; - } - } - - /* - * Emit a break instruction. - */ - - TclEmitOpcode(INST_BREAK, envPtr); - - done: - /* - * Instructions that raise exceptions don't really have to follow the - * usual stack management rules, but the cleanup code does. - */ - - TclAdjustStackDepth(1, envPtr); + /* + * Found the target! No need for a nasty INST_BREAK here. + */ + + TclCleanupStackForBreakContinue(envPtr, auxPtr); + TclAddLoopBreakFixup(envPtr, auxPtr); + TclAdjustStackDepth(1, envPtr); + } else { + /* + * Emit a real break. + */ + + PushStringLiteral(envPtr, ""); + TclEmitOpcode(INST_DUP, envPtr); + TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr); + TclEmitInt4(0, envPtr); + } + return TCL_OK; } /* *---------------------------------------------------------------------- @@ -838,46 +820,28 @@ * innermost containing exception range. */ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxPtr); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { - int toPop = envPtr->currStackDepth - auxPtr->stackDepth; - - /* - * Pop off the extra stack frames. - */ - - while (toPop > 0) { - TclEmitOpcode(INST_POP, envPtr); - TclAdjustStackDepth(1, envPtr); - toPop--; - } - - if (envPtr->expandCount == auxPtr->expandTarget) { - /* - * Found the target! Also, no built-up expansion stack. No need - * for a nasty INST_CONTINUE here. - */ - - TclAddLoopContinueFixup(envPtr, auxPtr); - goto done; - } - } - - /* - * Emit a continue instruction. - */ - - TclEmitOpcode(INST_CONTINUE, envPtr); - - done: - /* - * Instructions that raise exceptions don't really have to follow the - * usual stack management rules, but the cleanup code does. - */ - - TclAdjustStackDepth(1, envPtr); + /* + * Found the target! No need for a nasty INST_CONTINUE here. + */ + + TclCleanupStackForBreakContinue(envPtr, auxPtr); + TclAddLoopContinueFixup(envPtr, auxPtr); + TclAdjustStackDepth(1, envPtr); + } else { + /* + * Emit a real continue. + */ + + PushStringLiteral(envPtr, ""); + TclEmitOpcode(INST_DUP, envPtr); + TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr); + TclEmitInt4(0, envPtr); + } + return TCL_OK; } /* *---------------------------------------------------------------------- Index: generic/tclCompile.c ================================================================== --- generic/tclCompile.c +++ generic/tclCompile.c @@ -538,10 +538,14 @@ {"listConcat", 1, -1, 0, {OPERAND_NONE}}, /* Concatenates the two lists at the top of the stack into a single * list and pushes that resulting list onto the stack. * Stack: ... list1 list2 => ... [lconcat list1 list2] */ + {"expandDrop", 1, 0, 0, {OPERAND_NONE}}, + /* Drops an element from the auxiliary stack, popping stack elements + * until the matching stack depth is reached. */ + {NULL, 0, 0, 0, {OPERAND_NONE}} }; /* * Prototypes for procedures defined later in this file: @@ -569,10 +573,11 @@ static void RecordByteCodeStats(ByteCode *codePtr); #endif /* TCL_COMPILE_STATS */ static void RegisterAuxDataType(const AuxDataType *typePtr); static int SetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void StartExpanding(CompileEnv *envPtr); static int FormatInstruction(ByteCode *codePtr, const unsigned char *pc, Tcl_Obj *bufferObj); static void PrintSourceToObj(Tcl_Obj *appendObj, const char *stringPtr, int maxChars); static void UpdateStringOfInstName(Tcl_Obj *objPtr); @@ -2058,12 +2063,11 @@ * Should only start issuing instructions after the "command has * started" so that the command range is correct in the bytecode. */ if (expand) { - TclEmitOpcode(INST_EXPAND_START, envPtr); - envPtr->expandCount++; + StartExpanding(envPtr); } /* * TIP #280. Scan the words and compute the extended location * information. The map first contain full per-word line @@ -3464,10 +3468,11 @@ rangePtr->catchOffset = -1; auxPtr = &envPtr->exceptAuxArrayPtr[index]; auxPtr->supportsContinue = 1; auxPtr->stackDepth = envPtr->currStackDepth; auxPtr->expandTarget = envPtr->expandCount; + auxPtr->expandTargetDepth = -1; auxPtr->numBreakTargets = 0; auxPtr->breakTargets = NULL; auxPtr->allocBreakTargets = 0; auxPtr->numContinueTargets = 0; auxPtr->continueTargets = NULL; @@ -3584,10 +3589,107 @@ } /* * --------------------------------------------------------------------- * + * TclCleanupStackForBreakContinue -- + * + * Ditch the extra elements from the auxiliary stack and the main + * stack. How to do this exactly depends on whether there are any + * elements on the auxiliary stack to pop. + * + * --------------------------------------------------------------------- + */ + +void +TclCleanupStackForBreakContinue( + CompileEnv *envPtr, + ExceptionAux *auxPtr) +{ + int toPop = envPtr->expandCount - auxPtr->expandTarget; + + if (toPop > 0) { + while (toPop > 0) { + TclEmitOpcode(INST_EXPAND_DROP, envPtr); + toPop--; + } + toPop = auxPtr->expandTargetDepth - auxPtr->stackDepth; + while (toPop > 0) { + TclEmitOpcode(INST_POP, envPtr); + TclAdjustStackDepth(1, envPtr); + toPop--; + } + } else { + toPop = envPtr->currStackDepth - auxPtr->stackDepth; + while (toPop > 0) { + TclEmitOpcode(INST_POP, envPtr); + TclAdjustStackDepth(1, envPtr); + toPop--; + } + } +} + +/* + * --------------------------------------------------------------------- + * + * StartExpanding -- + * + * Pushes an INST_EXPAND_START and does some additional housekeeping so + * that the [break] and [continue] compilers can use an exception-free + * issue to discard it. + * + * --------------------------------------------------------------------- + */ + +static void +StartExpanding( + CompileEnv *envPtr) +{ + int i; + + TclEmitOpcode(INST_EXPAND_START, envPtr); + + /* + * Update inner exception ranges with information about the environment + * where this expansion started. + */ + + for (i=0 ; iexceptArrayNext ; i++) { + ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i]; + ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[i]; + + /* + * Ignore loops unless they're still being built. + */ + + if (rangePtr->codeOffset > CurrentOffset(envPtr)) { + continue; + } + if (rangePtr->numCodeBytes != -1) { + continue; + } + + /* + * Adequate condition: further out loops and further in exceptions + * don't actually need this information. + */ + + if (auxPtr->expandTarget == envPtr->expandCount) { + auxPtr->expandTargetDepth = envPtr->currStackDepth; + } + } + + /* + * There's now one more expansion being processed on the auxiliary stack. + */ + + envPtr->expandCount++; +} + +/* + * --------------------------------------------------------------------- + * * TclFinalizeLoopExceptionRange -- * * Finalizes a loop exception range, binding the registered [break] and * [continue] implementations so that they jump to the correct place. * Note that this must only be called after *all* the exception range @@ -3624,11 +3726,12 @@ site = envPtr->codeStart + auxPtr->continueTargets[i]; if (rangePtr->continueOffset == -1) { int j; /* - * WTF? Can't bind, so revert to an INST_CONTINUE. + * WTF? Can't bind, so revert to an INST_CONTINUE. Not enough + * space to do anything else. */ *site = INST_CONTINUE; for (j=0 ; j<4 ; j++) { *++site = INST_NOP; Index: generic/tclCompile.h ================================================================== --- generic/tclCompile.h +++ generic/tclCompile.h @@ -118,10 +118,15 @@ int expandTarget; /* The number of expansions expected on the * auxData stack at the time the loop starts; * we can't currently discard them except by * doing INST_INVOKE_EXPANDED; this is a known * problem. */ + int expandTargetDepth; /* The stack depth expected at the outermost + * expansion within the loop. Not meaningful + * if there have are no open expansions + * between the looping level and the point of + * jump issue. */ int numBreakTargets; /* The number of [break]s that want to be * targeted to the place where this loop * exception will be bound to. */ int *breakTargets; /* The offsets of the INST_JUMP4 instructions * issued by the [break]s that we must @@ -770,12 +775,14 @@ #define INST_INVOKE_REPLACE 163 #define INST_LIST_CONCAT 164 +#define INST_EXPAND_DROP 165 + /* The last opcode */ -#define LAST_INST_OPCODE 164 +#define LAST_INST_OPCODE 165 /* * Table describing the Tcl bytecode instructions: their name (for displaying * code), total number of code bytes required (including operand bytes), and a * description of the type of each operand. These operand types include signed @@ -983,10 +990,12 @@ * not used outside: *---------------------------------------------------------------- */ MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr); +MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr, + ExceptionAux *auxPtr); MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script, int numBytes, CompileEnv *envPtr, int optimize); Index: generic/tclExecute.c ================================================================== --- generic/tclExecute.c +++ generic/tclExecute.c @@ -255,11 +255,11 @@ * and within range. */ /* Verify the stack depth, only when no expansion is in progress */ -#if TCL_COMPILE_DEBUG +#ifdef TCL_COMPILE_DEBUG #define CHECK_STACK() \ do { \ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \ /*checkStack*/ !(starting || auxObjList)); \ starting = 0; \ @@ -2628,11 +2628,11 @@ if (length + appendLen < 0) { /* TODO: convert panic to error ? */ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } -#if !TCL_COMPILE_DEBUG +#ifndef TCL_COMPILE_DEBUG if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) { TclFreeIntRep(objResultPtr); objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1); objResultPtr->length = length + appendLen; p = TclGetString(objResultPtr) + length; @@ -2664,11 +2664,11 @@ if (length + appendLen < 0) { /* TODO: convert panic to error ? */ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } -#if !TCL_COMPILE_DEBUG +#ifndef TCL_COMPILE_DEBUG if (!Tcl_IsShared(objResultPtr)) { bytes = (char *) Tcl_SetByteArrayLength(objResultPtr, length + appendLen); p = bytes + length; currPtr = &OBJ_AT_DEPTH(opnd - 2); @@ -2715,10 +2715,26 @@ TclNewObj(objPtr); objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH; PUSH_TAUX_OBJ(objPtr); NEXT_INST_F(1, 0, 0); + + case INST_EXPAND_DROP: + /* + * Drops an element of the auxObjList, popping stack elements to + * restore the stack to the state before the point where the aux + * element was created. + */ + + CLANG_ASSERT(auxObjList); + objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value; + POP_TAUX_OBJ(); +#ifdef TCL_COMPILE_DEBUG + /* Ugly abuse! */ + starting = 1; +#endif + NEXT_INST_V(1, objc, 0); case INST_EXPAND_STKTOP: { int i; ptrdiff_t moved; @@ -6822,11 +6838,11 @@ * something different from TCL_OK, or else INST_BREAK or * INST_CONTINUE were called. */ processExceptionReturn: -#if TCL_COMPILE_DEBUG +#ifdef TCL_COMPILE_DEBUG switch (*pc) { case INST_INVOKE_STK1: opnd = TclGetUInt1AtPtr(pc+1); TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf)); break; @@ -6879,11 +6895,11 @@ TRACE_APPEND(("%s, range at %d, new pc %d\n", StringForResultCode(result), rangePtr->codeOffset, rangePtr->continueOffset)); NEXT_INST_F(0, 0, 0); } -#if TCL_COMPILE_DEBUG +#ifdef TCL_COMPILE_DEBUG if (traceInstructions) { objPtr = Tcl_GetObjResult(interp); if ((result != TCL_ERROR) && (result != TCL_RETURN)) { TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ", result, O2S(objPtr))); Index: tests/for.test ================================================================== --- tests/for.test +++ tests/for.test @@ -852,11 +852,11 @@ set end [meminfo] } expr {$end - $tmp} }} } 0 -test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} {memory knownBug} { +test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { @@ -866,18 +866,78 @@ set end [meminfo] } expr {$end - $tmp} }} } 0 -test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} {memory knownBug} { +test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] for {set i 0} {$i < 5} {incr i} { for {set x 0} {[incr x]<50} {} { puts {*}[puts a b c {*}[continue] d e f] } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.5 {Bug 3614226: ensure that break cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.6 {Bug 3614226: ensure that continue cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.7 {Bug 3614226: ensure that break only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] + }] set tmp $end set end [meminfo] } expr {$end - $tmp} }}