core: support multi-level break, continue from loops

jim.c

@@ -12281,6 +12281,23 @@ static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar
     return JIM_OK;
 }
 
+/**
+ * All commands that support break, continue from a loop (while, loop, foreach, for)
+ * use this to check for returnLevel.
+ *
+ * If returnLevel is > 0, decrements the returnLevel and returns 1.
+ * Otherwise returns 0
+ */
+static int JimCheckLoopRetcode(Jim_Interp *interp, int retval)
+{
+    if (retval == JIM_BREAK || retval == JIM_CONTINUE) {
+        if (--interp->returnLevel > 0) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
 /* [while] */
 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 {
@@ -12299,13 +12316,14 @@ static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar
             break;
 
         if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
+            if (JimCheckLoopRetcode(interp, retval)) {
+                return retval;
+            }
             switch (retval) {
                 case JIM_BREAK:
                     goto out;
-                    break;
                 case JIM_CONTINUE:
                     continue;
-                    break;
                 default:
                     return retval;
             }
@@ -12321,6 +12339,7 @@ static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv
 {
     int retval;
     int boolean = 1;
+    int immediate = 0;
     Jim_Obj *varNamePtr = NULL;
     Jim_Obj *stopVarNamePtr = NULL;
 
@@ -12441,6 +12460,10 @@ static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv
 
             /* Eval body */
             retval = Jim_EvalObj(interp, argv[4]);
+            if (JimCheckLoopRetcode(interp, retval)) {
+                immediate++;
+                goto out;
+            }
             if (retval == JIM_OK || retval == JIM_CONTINUE) {
                 retval = JIM_OK;
 
@@ -12477,6 +12500,10 @@ static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv
             /* increment */
 JIM_IF_OPTIM(evalnext:)
             retval = Jim_EvalObj(interp, argv[3]);
+            if (JimCheckLoopRetcode(interp, retval)) {
+                immediate++;
+                goto out;
+            }
             if (retval == JIM_OK || retval == JIM_CONTINUE) {
                 /* test */
 JIM_IF_OPTIM(testcond:)
@@ -12492,9 +12519,11 @@ JIM_IF_OPTIM(out:)
         Jim_DecrRefCount(interp, varNamePtr);
     }
 
-    if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
-        Jim_SetEmptyResult(interp);
-        return JIM_OK;
+    if (!immediate) {
+        if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
+            Jim_SetEmptyResult(interp);
+            return JIM_OK;
+        }
     }
 
     return retval;
@@ -12534,6 +12563,9 @@ static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
 
     while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
         retval = Jim_EvalObj(interp, bodyObjPtr);
+        if (JimCheckLoopRetcode(interp, retval)) {
+            return retval;
+        }
         if (retval == JIM_OK || retval == JIM_CONTINUE) {
             Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
 
@@ -12688,7 +12720,11 @@ static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *arg
                 }
             }
         }
-        switch (result = Jim_EvalObj(interp, script)) {
+        result = Jim_EvalObj(interp, script);
+        if (JimCheckLoopRetcode(interp, result)) {
+            goto err;
+        }
+        switch (result) {
             case JIM_OK:
                 if (doMap) {
                     Jim_ListAppendElement(interp, resultObj, interp->result);
@@ -13828,24 +13864,33 @@ static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
     return retcode;
 }
 
-/* [break] */
-static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+static int JimBreakContinueHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int retcode)
 {
-    if (argc != 1) {
-        Jim_WrongNumArgs(interp, 1, argv, "");
+    if (argc != 1 && argc != 2) {
+        Jim_WrongNumArgs(interp, 1, argv, "?level?");
         return JIM_ERR;
     }
-    return JIM_BREAK;
+    if (argc == 2) {
+        long level;
+        int ret = Jim_GetLong(interp, argv[1], &level);
+        if (ret != JIM_OK) {
+            return ret;
+        }
+        interp->returnLevel = level;
+    }
+    return retcode;
+}
+
+/* [break] */
+static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+    return JimBreakContinueHelper(interp, argc, argv, JIM_BREAK);
 }
 
 /* [continue] */
 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 {
-    if (argc != 1) {
-        Jim_WrongNumArgs(interp, 1, argv, "");
-        return JIM_ERR;
-    }
-    return JIM_CONTINUE;
+    return JimBreakContinueHelper(interp, argc, argv, JIM_CONTINUE);
 }
 
 /* [return] */

jim_tcl.txt

@@ -3,7 +3,7 @@ Jim Tcl(n)
 
 NAME
 ----
-Jim Tcl v0.82 - reference manual for the Jim Tcl scripting language
+Jim Tcl v0.82+ - reference manual for the Jim Tcl scripting language
 
 SYNOPSIS
 --------
@@ -52,6 +52,10 @@ Some notable differences with Tcl 8.5/8.6/8.7 are:
 
 RECENT CHANGES
 --------------
+Changes since 0.82
+~~~~~~~~~~~~~~~~~~
+1. Multi-level `break` and `continue` are now supported
+
 Changes between 0.81 and 0.82
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1. `try` now supports trap to match on errorcode
@@ -1882,12 +1886,26 @@ command.  The legal +'options'+ (which may be abbreviated) are:
 
 break
 ~~~~~
-+*break*+
++*break* ?n?+
 
 This command may be invoked only inside the body of a loop command
-such as `for` or `foreach` or `while`.  It returns a +JIM_BREAK+ code
+such as `for`, `foreach`, `while` or `loop`.  It returns a +JIM_BREAK+ code
 to signal the innermost containing loop command to return immediately.
 
+If +'n'+ is given it breaks out of that many loops. +'break 1'+ is equivalent
+to a simple +'break'+ while in the following example, +'break'+ will exit both
+loops.
+
+----
+    loop i 5 {
+        loop j 6 {
+            if {$i == 3 && $j == 2} {
+                break 2
+            }
+        }
+    }
+----
+
 case
 ~~~~
 The obsolete '+*case*+' command has been removed from Jim Tcl since v0.75.
@@ -2032,13 +2050,16 @@ as its result.
 
 continue
 ~~~~~~~~
-+*continue*+
++*continue* ?n?+
 
 This command may be invoked only inside the body of a loop command such
-as `for` or `foreach` or `while`.  It returns a  +JIM_CONTINUE+ code to
+as `for`, `foreach`, `while` or `loop`.  It returns a  +JIM_CONTINUE+ code to
 signal the innermost containing loop command to skip the remainder of
 the loop's body but continue with the next iteration of the loop.
 
+If +'n'+ is given it breaks out of +'n-1'+ loops and then continues the +'nth'+ loop.
++'continue 1'+ is equivalent to a simple +'continue'+. (See also `break`).
+
 curry
 ~~~~~
 +*alias* 'args\...'+

tests/breakcontinue.test

@@ -0,0 +1,127 @@
+# Test multi-level break, continue in loops
+
+source [file dirname [info script]]/testing.tcl
+
+needs constraint jim
+
+proc whiletester {type {level {}}} {
+	set result {}
+	set i 0
+	while {$i < 3} {
+		incr i
+		set j 0
+		set subresult {}
+		while {$j < 5} {
+			incr j
+			if {$i == 2 && $j == 2} {
+				$type {*}$level
+			}
+			lappend subresult $($i * 10 + $j)
+		}
+		lappend result $subresult
+	}
+	return $result
+}
+
+proc looptester {type {level {}}} {
+	set result {}
+	loop i 1 4 {
+		set subresult {}
+		loop j 1 6 {
+			if {$i == 2 && $j == 2} {
+				$type {*}$level
+			}
+			lappend subresult $($i * 10 + $j)
+		}
+		lappend result $subresult
+	}
+	return $result
+}
+
+proc foreachtester {type {level {}}} {
+	set result {}
+	foreach i {1 2 3} {
+		set subresult {}
+		foreach j {1 2 3 4 5} {
+			if {$i == 2 && $j == 2} {
+				$type {*}$level
+			}
+			lappend subresult $($i * 10 + $j)
+		}
+		lappend result $subresult
+	}
+	return $result
+}
+
+proc fortester {type {level {}}} {
+	set result {}
+	for {set i 1} {$i < 4} {incr i} {
+		set subresult {}
+		for {set j 1} {$j < 6} {incr j} {
+			if {$i == 2 && $j == 2} {
+				$type {*}$level
+			}
+			lappend subresult $($i * 10 + $j)
+		}
+		lappend result $subresult
+	}
+	return $result
+}
+
+test while-1.1 {one level break} -body {
+	whiletester break
+} -result {{11 12 13 14 15} 21 {31 32 33 34 35}}
+
+test while-1.2 {two level break} -body {
+	whiletester break 2
+} -result {{11 12 13 14 15}}
+
+test while-1.3 {one level continue} -body {
+	whiletester continue
+} -result {{11 12 13 14 15} {21 23 24 25} {31 32 33 34 35}}
+
+test while-1.4 {two level continue} -body {
+	whiletester continue 2
+} -result {{11 12 13 14 15} {31 32 33 34 35}}
+
+test loop-1.1 {one level break} -body {
+	looptester break
+} -result {{11 12 13 14 15} 21 {31 32 33 34 35}}
+
+test loop-1.2 {two level break} -body {
+	looptester break 2
+} -result {{11 12 13 14 15}}
+
+test loop-1.3 {one level continue} -body {
+	looptester continue
+} -result {{11 12 13 14 15} {21 23 24 25} {31 32 33 34 35}}
+
+test loop-1.4 {two level continue} -body {
+	looptester continue 2
+} -result {{11 12 13 14 15} {31 32 33 34 35}}
+
+test foreach-1.2 {two level break} -body {
+	foreachtester break 2
+} -result {{11 12 13 14 15}}
+
+test foreach-1.3 {one level continue} -body {
+	foreachtester continue
+} -result {{11 12 13 14 15} {21 23 24 25} {31 32 33 34 35}}
+
+test foreach-1.4 {two level continue} -body {
+	foreachtester continue 2
+} -result {{11 12 13 14 15} {31 32 33 34 35}}
+
+test for-1.2 {two level break} -body {
+	fortester break 2
+} -result {{11 12 13 14 15}}
+
+test for-1.3 {one level continue} -body {
+	fortester continue
+} -result {{11 12 13 14 15} {21 23 24 25} {31 32 33 34 35}}
+
+test for-1.4 {two level continue} -body {
+	fortester continue 2
+} -result {{11 12 13 14 15} {31 32 33 34 35}}
+
+testreport