summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclCompCmds.c11
-rw-r--r--generic/tclCompile.c35
-rw-r--r--generic/tclCompile.h13
-rw-r--r--tests/for.test74
4 files changed, 119 insertions, 14 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index f2d2963..3046841 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -491,7 +491,7 @@ TclCompileBreakCmd(
* Find the innermost exception range that contains this command.
*/
- rangePtr = TclGetInnermostExceptionRange(envPtr, &auxPtr);
+ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxPtr);
if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
int toPop = envPtr->currStackDepth - auxPtr->stackDepth;
@@ -505,14 +505,13 @@ TclCompileBreakCmd(
toPop--;
}
- if (envPtr->expandCount == 0) {
+ 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);
- TclEmitInstInt4(INST_JUMP4, 0, envPtr);
goto done;
}
}
@@ -839,7 +838,7 @@ TclCompileContinueCmd(
* innermost containing exception range.
*/
- rangePtr = TclGetInnermostExceptionRange(envPtr, &auxPtr);
+ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxPtr);
if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
int toPop = envPtr->currStackDepth - auxPtr->stackDepth;
@@ -853,14 +852,13 @@ TclCompileContinueCmd(
toPop--;
}
- if (envPtr->expandCount == 0) {
+ 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);
- TclEmitInstInt4(INST_JUMP4, 0, envPtr);
goto done;
}
}
@@ -2467,6 +2465,7 @@ TclCompileForCmd(
*/
nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
envPtr->currStackDepth = savedStackDepth;
nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
SetLineInformation(3);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 96f8683..f2e9329 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -3463,7 +3463,9 @@ TclCreateExceptRange(
rangePtr->continueOffset = -1;
rangePtr->catchOffset = -1;
auxPtr = &envPtr->exceptAuxArrayPtr[index];
+ auxPtr->supportsContinue = 1;
auxPtr->stackDepth = envPtr->currStackDepth;
+ auxPtr->expandTarget = envPtr->expandCount;
auxPtr->numBreakTargets = 0;
auxPtr->breakTargets = NULL;
auxPtr->allocBreakTargets = 0;
@@ -3490,6 +3492,7 @@ TclCreateExceptRange(
ExceptionRange *
TclGetInnermostExceptionRange(
CompileEnv *envPtr,
+ int returnCode,
ExceptionAux **auxPtrPtr)
{
int exnIdx = -1, i;
@@ -3499,7 +3502,9 @@ TclGetInnermostExceptionRange(
if (CurrentOffset(envPtr) >= rangePtr->codeOffset &&
(rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) <
- rangePtr->codeOffset+rangePtr->numCodeBytes)) {
+ rangePtr->codeOffset+rangePtr->numCodeBytes) &&
+ (returnCode != TCL_CONTINUE ||
+ envPtr->exceptAuxArrayPtr[i].supportsContinue)) {
exnIdx = i;
}
}
@@ -3512,6 +3517,19 @@ TclGetInnermostExceptionRange(
return &envPtr->exceptArrayPtr[exnIdx];
}
+/*
+ * ---------------------------------------------------------------------
+ *
+ * TclAddLoopBreakFixup, TclAddLoopContinueFixup --
+ *
+ * Adds a place that wants to break/continue to the loop exception range
+ * tracking that will be fixed up once the loop can be finalized. These
+ * functions will generate an INST_JUMP4 that will be fixed up during the
+ * loop finalization.
+ *
+ * ---------------------------------------------------------------------
+ */
+
void
TclAddLoopBreakFixup(
CompileEnv *envPtr,
@@ -3535,6 +3553,7 @@ TclAddLoopBreakFixup(
}
}
auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
+ TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}
void
@@ -3561,7 +3580,21 @@ TclAddLoopContinueFixup(
}
auxPtr->continueTargets[auxPtr->numContinueTargets - 1] =
CurrentOffset(envPtr);
+ TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * 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
+ * target offsets have been set.
+ *
+ * ---------------------------------------------------------------------
+ */
void
TclFinalizeLoopExceptionRange(
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 4b50710..957c724 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -105,10 +105,21 @@ typedef struct ExceptionRange {
*/
typedef struct ExceptionAux {
+ int supportsContinue; /* Whether this exception range will have a
+ * continueOffset created for it; if it is a
+ * loop exception range that *doesn't* have
+ * one (see [for] next-clause) then we must
+ * not pick up the range when scanning for a
+ * target to continue to. */
int stackDepth; /* The stack depth at the point where the
* exception range was created. This is used
* to calculate the number of POPs required to
* restore the stack to its prior state. */
+ 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 numBreakTargets; /* The number of [break]s that want to be
* targeted to the place where this loop
* exception will be bound to. */
@@ -1029,7 +1040,7 @@ MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr);
MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
- ExceptionAux **auxPtrPtr);
+ int returnCode, ExceptionAux **auxPtrPtr);
MODULE_SCOPE void TclAddLoopBreakFixup(CompileEnv *envPtr,
ExceptionAux *auxPtr);
MODULE_SCOPE void TclAddLoopContinueFixup(CompileEnv *envPtr,
diff --git a/tests/for.test b/tests/for.test
index ff4dc0e..3f4d2b7 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -14,6 +14,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+# Used for constraining memory leak tests
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+ proc meminfo {} {lindex [split [memory info] "\n"] 3 3}
+}
+
# Basic "for" operation.
test for-1.1 {TclCompileForCmd: missing initial command} {
@@ -345,7 +351,6 @@ proc formatMail {} {
64 { UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
65 { binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
}
-
set result ""
set NL "
"
@@ -365,7 +370,6 @@ proc formatMail {} {
} else {
set break 1
}
-
set xmailer 0
set inheaders 1
set last [array size lines]
@@ -386,9 +390,7 @@ proc formatMail {} {
set limit 55
} else {
set limit 55
-
# Decide whether or not to break the body line
-
if {$plen > 0} {
if {[string first {> } $line] == 0} {
# This is quoted text from previous message, don't reformat
@@ -431,7 +433,7 @@ proc formatMail {} {
set climit [expr $limit-1]
set cutoff 50
set continuation 0
-
+
while {[string length $line] > $limit} {
for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} {
set char [string index $line $c]
@@ -824,7 +826,67 @@ test for-6.18 {Tcl_ForObjCmd: for command result} {
1 {invoked "continue" outside of a loop} \
]
-
+test for-7.1 {Bug 3614226: ensure that break cleans up the 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} {$x < 5} {incr x} {
+ list a b c [break] d e f
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.2 {Bug 3614226: ensure that continue cleans up the 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} {$x < 5} {incr x} {
+ list a b c [continue] d e f
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} {memory knownBug} {
+ 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 {*}[break] d e f]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} {memory knownBug} {
+ 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
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: