Generate [continue] optimally in [for] next clauses. Add tests for Bug 3614226.

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: