summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog76
-rw-r--r--generic/tclAssembly.c2
-rw-r--r--generic/tclCompCmds.c84
-rw-r--r--generic/tclCompile.c109
-rw-r--r--generic/tclCompile.h11
-rw-r--r--generic/tclExecute.c26
-rw-r--r--tests/for.test64
7 files changed, 265 insertions, 107 deletions
diff --git a/ChangeLog b/ChangeLog
index 53bcb80..15bab6e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,17 @@
+2013-06-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * 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 <nijtmans@users.sf.net>
- * 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 <msofer@users.sf.net>
@@ -10,7 +19,7 @@
(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 <dkf@users.sf.net>
@@ -24,14 +33,14 @@
2013-05-27 Harald Oehlmann <oehhar@users.sf.net>
* 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 <andreask@activestate.com>
* 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 <dkf@users.sf.net>
@@ -93,10 +102,9 @@
2013-04-30 Andreas Kupries <andreask@activestate.com>
* 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 <dkf@users.sf.net>
@@ -115,8 +123,8 @@
2013-04-19 Jan Nijtmans <nijtmans@users.sf.net>
* 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 <nijtmans@users.sf.net>
@@ -125,16 +133,16 @@
2013-04-08 Don Porter <dgp@users.sourceforge.net>
- * 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 <max@suse.de>
- * 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 <venkat@comit.com>
@@ -166,12 +174,12 @@
2013-03-21 Don Porter <dgp@users.sourceforge.net>
- * 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 <dgp@users.sourceforge.net>
- * 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 <nijtmans@users.sf.net>
@@ -191,20 +199,20 @@
2013-03-11 Don Porter <dgp@users.sourceforge.net>
- * 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 <dgp@users.sourceforge.net>
- * 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 <dgp@users.sourceforge.net>
- * 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:
@@ -4899,8 +4907,7 @@
2010-05-19 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
* 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 <nijtmans@users.sf.net>
@@ -6754,10 +6761,9 @@
2009-11-11 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * 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 <patthoyts@users.sourceforge.net>
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index d1af8c6..62641e6 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -20,7 +20,7 @@
*- 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
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 3046841..10a789e 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -493,42 +493,24 @@ TclCompileBreakCmd(
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.
+ * Found the target! No need for a nasty INST_BREAK here.
*/
- 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.
- */
+ TclCleanupStackForBreakContinue(envPtr, auxPtr);
+ TclAddLoopBreakFixup(envPtr, auxPtr);
+ TclAdjustStackDepth(1, envPtr);
+ } else {
+ /*
+ * Emit a real break.
+ */
- TclAddLoopBreakFixup(envPtr, auxPtr);
- goto done;
- }
+ PushStringLiteral(envPtr, "");
+ TclEmitOpcode(INST_DUP, envPtr);
+ TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr);
+ TclEmitInt4(0, envPtr);
}
- /*
- * 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);
return TCL_OK;
}
@@ -840,42 +822,24 @@ TclCompileContinueCmd(
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.
+ * Found the target! No need for a nasty INST_CONTINUE here.
*/
- 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.
- */
+ TclCleanupStackForBreakContinue(envPtr, auxPtr);
+ TclAddLoopContinueFixup(envPtr, auxPtr);
+ TclAdjustStackDepth(1, envPtr);
+ } else {
+ /*
+ * Emit a real continue.
+ */
- TclAddLoopContinueFixup(envPtr, auxPtr);
- goto done;
- }
+ PushStringLiteral(envPtr, "");
+ TclEmitOpcode(INST_DUP, envPtr);
+ TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr);
+ TclEmitInt4(0, envPtr);
}
- /*
- * 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);
return TCL_OK;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index f2e9329..69517bc 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -540,6 +540,10 @@ InstructionDesc const tclInstructionTable[] = {
* 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}}
};
@@ -571,6 +575,7 @@ static void RecordByteCodeStats(ByteCode *codePtr);
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,
@@ -2060,8 +2065,7 @@ TclCompileScript(
*/
if (expand) {
- TclEmitOpcode(INST_EXPAND_START, envPtr);
- envPtr->expandCount++;
+ StartExpanding(envPtr);
}
/*
@@ -3466,6 +3470,7 @@ TclCreateExceptRange(
auxPtr->supportsContinue = 1;
auxPtr->stackDepth = envPtr->currStackDepth;
auxPtr->expandTarget = envPtr->expandCount;
+ auxPtr->expandTargetDepth = -1;
auxPtr->numBreakTargets = 0;
auxPtr->breakTargets = NULL;
auxPtr->allocBreakTargets = 0;
@@ -3586,6 +3591,103 @@ TclAddLoopContinueFixup(
/*
* ---------------------------------------------------------------------
*
+ * 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 ; i<envPtr->exceptArrayNext ; 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
@@ -3626,7 +3728,8 @@ TclFinalizeLoopExceptionRange(
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;
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 957c724..15b5477 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -120,6 +120,11 @@ typedef struct ExceptionAux {
* 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. */
@@ -772,8 +777,10 @@ typedef struct ByteCode {
#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
@@ -985,6 +992,8 @@ MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
*/
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);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8c87364..443fb85 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -257,7 +257,7 @@ VarHashCreateVar(
/* 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, \
@@ -2630,7 +2630,7 @@ TEBCresume(
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);
@@ -2666,7 +2666,7 @@ TEBCresume(
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);
@@ -2718,6 +2718,22 @@ TEBCresume(
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;
@@ -6824,7 +6840,7 @@ TEBCresume(
*/
processExceptionReturn:
-#if TCL_COMPILE_DEBUG
+#ifdef TCL_COMPILE_DEBUG
switch (*pc) {
case INST_INVOKE_STK1:
opnd = TclGetUInt1AtPtr(pc+1);
@@ -6881,7 +6897,7 @@ TEBCresume(
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)) {
diff --git a/tests/for.test b/tests/for.test
index 3f4d2b7..8936682 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -854,7 +854,7 @@ test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory {
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]
@@ -868,7 +868,7 @@ test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} {mem
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]
@@ -882,6 +882,66 @@ test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} {
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}
+ }}
+} 0
# cleanup
::tcltest::cleanupTests
generated by cgit v0.12 at 2024-11-24 04:45:02 (GMT)