From d455df785b1c4f6037260e8d3575e346da9a360e Mon Sep 17 00:00:00 2001
From: antirez <antirez>
Date: Sun, 6 Mar 2005 22:42:33 +0000
Subject: A specializing version of [for] that appears able to match the
 performaces of Tcl8.4 for the specialized forms. The implementation is a bit
 complex so may contain bugs... to handle with care. Also a [for] bug about
 [continue] was fixed and the regression test added.

---
 bench.tcl   |  23 +++-
 jim.c       | 239 ++++++++++++++++++++++++++++++++++--
 regtest.tcl |   5 +
 test.tcl    | 399 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 4 files changed, 648 insertions(+), 18 deletions(-)

diff --git a/bench.tcl b/bench.tcl
index 055aac1..84cea2c 100644
--- a/bench.tcl
+++ b/bench.tcl
@@ -9,7 +9,7 @@ proc bench {title script} {
 
 ### BUSY LOOP ##################################################################
 
-proc x {} {
+proc busyloop {} {
     set i 0
     while {$i < 1850000} {
 	incr i
@@ -97,16 +97,16 @@ proc sieve {num} {
     while {$num > 0} {
 	incr num -1
 	set count 0
-	for {set i 2} {$i <= 8192} {incr i 1} {
+	for {set i 2} {$i <= 8192} {incr i} {
 	    set flags($i) 1
 	}
-	for {set i 2} {$i <= 8192} {incr i 1} {
+	for {set i 2} {$i <= 8192} {incr i} {
 	    if {$flags($i) == 1} {
 		# remove all multiples of prime: i
 		for {set k [expr {$i+$i}]} {$k <= 8192} {incr k $i} {
 		    set flags($k) 0
 		}
-		incr count 1
+		incr count
 	    }
 	}
     }
@@ -254,9 +254,22 @@ proc expand {} {
     }
 }
 
+### MINLOOPS ###################################################################
+
+proc miniloops {} {
+    for {set i 0} {$i < 100000} {incr i} {
+        set sum 0
+        for {set j 0} {$j < 10} {incr j} {
+            # something of more or less real
+            incr sum $j
+        }
+    }
+}
+
 ### RUN ALL ####################################################################
 
-bench {busy loop} {x}
+bench {busy loop} {busyloop}
+bench {mini loops} {miniloops}
 bench {fibonacci(25)} {fibonacci 25}
 bench {heapsort} {heapsort_main}
 bench {sieve} {sieve 10}
diff --git a/jim.c b/jim.c
index a69c02e..09f2e30 100644
--- a/jim.c
+++ b/jim.c
@@ -1,7 +1,7 @@
 /* Jim - A small embeddable Tcl interpreter
  * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
  *
- * $Id: jim.c,v 1.69 2005/03/06 10:43:06 antirez Exp $
+ * $Id: jim.c,v 1.70 2005/03/06 22:42:33 antirez Exp $
  *
  * Licensed under the Apache License, Version 2.0 (the "License");
  * you may not use this file except in compliance with the License.
@@ -20,6 +20,7 @@
  */
 
 #define __JIM_CORE__
+#define JIM_OPTIMIZATION
 
 #include <stdio.h>
 #include <stdlib.h>
@@ -2625,6 +2626,7 @@ int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
         cmdPtr->delProc = delProc;
         Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
     } else {
+        Jim_InterpIncrProcEpoch(interp);
         /* Free the arglist/body objects if it was a Tcl procedure */
         cmdPtr = he->val;
         if (cmdPtr->cmdProc == NULL) {
@@ -2662,6 +2664,7 @@ int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
         cmdPtr->arityMax = arityMax;
         Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
     } else {
+        Jim_InterpIncrProcEpoch(interp);
         /* Free the arglist/body objects if it was a Tcl procedure */
         cmdPtr = he->val;
         if (cmdPtr->cmdProc == NULL) {
@@ -6930,11 +6933,12 @@ int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
     script->fileName = NULL;
 
     JimParserInit(&parser, scriptText, scriptTextLen, 1);
-    while(!JimParserEof(&parser)) {
+    while(1) {
         char *token;
         int len, type, linenr;
 
         JimParseSubst(&parser, flags);
+        if (JimParserEof(&parser)) break;
         token = JimParserGetToken(&parser, &len, &type, &linenr);
         ScriptObjAddToken(interp, script, token, len, type,
                 NULL, linenr);
@@ -6968,8 +6972,26 @@ int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
     int i, len, retcode = JIM_OK;
     Jim_Obj *resObjPtr, *savedResultObjPtr;
 
-    Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
     script = Jim_GetSubst(interp, substObjPtr, flags);
+#ifdef JIM_OPTIMIZATION
+    /* Fast path for a very common case with array-alike syntax,
+     * that's: $foo($bar) */
+    if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
+        Jim_Obj *varObjPtr = script->token[0].objPtr;
+        
+        Jim_IncrRefCount(varObjPtr);
+        resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
+        if (resObjPtr == NULL) {
+            Jim_DecrRefCount(interp, varObjPtr);
+            return JIM_ERR;
+        }
+        Jim_DecrRefCount(interp, varObjPtr);
+        *resObjPtrPtr = resObjPtr;
+        return JIM_OK;
+    }
+#endif
+
+    Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
     /* In order to preserve the internal rep, we increment the
      * inUse field of the script internal rep structure. */
     script->inUse++;
@@ -7007,8 +7029,6 @@ int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
                 goto err;
             Jim_AppendObj(interp, resObjPtr, interp->result);
             break;
-        case JIM_TT_EOL:
-            break;
         default:
             Jim_Panic(
               "default token type (%d) reached "
@@ -7535,11 +7555,176 @@ static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
         Jim_WrongNumArgs(interp, 1, argv, "start test next body");
         return JIM_ERR;
     }
+    /* Check if the for is on the form: for {set i 0} {$i < CONST} {incr i} */
+    /* XXX: NOTE: if variable traces are implemented, this optimization
+     * need to be modified to check for the proc epoch at every variable
+     * update. */
+#ifdef JIM_OPTIMIZATION
+    {
+        ScriptObj *initScript, *incrScript;
+        ExprByteCode *expr;
+        jim_wide start, stop, currentVal;
+        unsigned jim_wide procEpoch = interp->procEpoch;
+        Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
+        int cmpType;
+        struct Jim_Cmd *cmdPtr;
+
+        /* Do it only if there aren't shared arguments */
+        if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
+            goto evalstart;
+        initScript = Jim_GetScript(interp, argv[1]);
+        expr = Jim_GetExpression(interp, argv[2]);
+        incrScript = Jim_GetScript(interp, argv[3]);
+
+        /* Ensure proper lengths to start */
+        if (initScript->len != 6) goto evalstart;
+        if (incrScript->len != 4) goto evalstart;
+        if (expr->len != 3) goto evalstart;
+        /* Ensure proper token types. */
+        if (initScript->token[2].type != JIM_TT_ESC ||
+            initScript->token[4].type != JIM_TT_ESC ||
+            incrScript->token[2].type != JIM_TT_ESC ||
+            expr->opcode[0] != JIM_EXPROP_VARIABLE ||
+            (expr->opcode[1] != JIM_EXPROP_NUMBER &&
+             expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
+            (expr->opcode[2] != JIM_EXPROP_LT &&
+             expr->opcode[2] != JIM_EXPROP_LTE))
+            goto evalstart;
+        cmpType = expr->opcode[2];
+        /* Initialization command must be [set] */
+        cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
+        if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
+            goto evalstart;
+        /* Update command must be incr */
+        cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
+        if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
+            goto evalstart;
+        /* set, incr, expression must be about the same variable */
+        if (!Jim_StringEqObj(initScript->token[2].objPtr,
+                            incrScript->token[2].objPtr, 0))
+            goto evalstart;
+        if (!Jim_StringEqObj(initScript->token[2].objPtr,
+                            expr->obj[0], 0))
+            goto evalstart;
+        /* Check that the initialization and comparison are valid integers */
+        if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
+            goto evalstart;
+        if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
+            Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
+        {
+            goto evalstart;
+        }
+
+        /* Initialization */
+        varNamePtr = expr->obj[0];
+        if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
+            stopVarNamePtr = expr->obj[1];
+            Jim_IncrRefCount(stopVarNamePtr);
+        }
+        Jim_IncrRefCount(varNamePtr);
+
+        /* --- OPTIMIZED FOR --- */
+        /* Start to loop */
+        objPtr = Jim_NewIntObj(interp, start);
+        if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
+            Jim_DecrRefCount(interp, varNamePtr);
+            if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
+            Jim_IncrRefCount(objPtr);
+            Jim_DecrRefCount(interp, objPtr);
+            goto evalstart;
+        }
+        while (1) {
+            /* === Check condition === */
+            /* Common code: */
+            objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
+            if (objPtr == NULL ||
+                Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
+            {
+                Jim_DecrRefCount(interp, varNamePtr);
+                if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
+                goto testcond;
+            }
+            /* Immediate or Variable? get the 'stop' value if the latter. */
+            if (stopVarNamePtr) {
+                objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
+                if (objPtr == NULL ||
+                    Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
+                {
+                    Jim_DecrRefCount(interp, varNamePtr);
+                    Jim_DecrRefCount(interp, stopVarNamePtr);
+                    goto testcond;
+                }
+            }
+            if (cmpType == JIM_EXPROP_LT) {
+                if (currentVal >= stop) break;
+            } else {
+                if (currentVal > stop) break;
+            }
+            /* Eval body */
+            if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
+                switch(retval) {
+                case JIM_BREAK:
+                    if (stopVarNamePtr)
+                        Jim_DecrRefCount(interp, stopVarNamePtr);
+                    Jim_DecrRefCount(interp, varNamePtr);
+                    goto out;
+                case JIM_CONTINUE:
+                    /* nothing to do */
+                    break;
+                default:
+                    if (stopVarNamePtr)
+                        Jim_DecrRefCount(interp, stopVarNamePtr);
+                    Jim_DecrRefCount(interp, varNamePtr);
+                    return JIM_ERR;
+                }
+            }
+            /* If there was a change in procedures/command continue
+             * with the usual [for] command implementation */
+            if (procEpoch != interp->procEpoch) {
+                if (stopVarNamePtr)
+                    Jim_DecrRefCount(interp, stopVarNamePtr);
+                Jim_DecrRefCount(interp, varNamePtr);
+                goto evalnext;
+            }
+            /* Increment */
+            objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
+            if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
+                objPtr->internalRep.wideValue ++;
+                Jim_InvalidateStringRep(objPtr);
+            } else {
+                Jim_Obj *auxObjPtr;
+
+                if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
+                    if (stopVarNamePtr)
+                        Jim_DecrRefCount(interp, stopVarNamePtr);
+                    Jim_DecrRefCount(interp, varNamePtr);
+                    goto evalnext;
+                }
+                auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
+                if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
+                    if (stopVarNamePtr)
+                        Jim_DecrRefCount(interp, stopVarNamePtr);
+                    Jim_DecrRefCount(interp, varNamePtr);
+                    Jim_IncrRefCount(auxObjPtr);
+                    Jim_DecrRefCount(interp, auxObjPtr);
+                    goto evalnext;
+                }
+            }
+        }
+        if (stopVarNamePtr)
+            Jim_DecrRefCount(interp, stopVarNamePtr);
+        Jim_DecrRefCount(interp, varNamePtr);
+        Jim_SetEmptyResult(interp);
+        return JIM_OK;
+    }
+#endif
+evalstart:
     /* Eval start */
     if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
         return retval;
     while (1) {
         int boolean;
+testcond:
         /* Test the condition */
         if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
                 != JIM_OK)
@@ -7552,12 +7737,13 @@ static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
                 goto out;
                 break;
             case JIM_CONTINUE:
-                continue;
+                /* Nothing to do */
                 break;
             default:
                 return retval;
             }
         }
+evalnext:
         /* Eval next */
         if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
             switch(retval) {
@@ -7976,21 +8162,30 @@ static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, 
         Jim_Obj *const *argv)
 {
-    const char *subcommand;
+    const char *options[] = {
+        "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
+    };
+    enum {
+        OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
+        OPT_EXPRLEN
+    };
+    int option;
 
     if (argc < 2) {
         Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
         return JIM_ERR;
     }
-    subcommand = Jim_GetString(argv[1], NULL);
-    if (!strcmp(subcommand, "refcount")) {
+    if (Jim_GetEnum(interp, argv[1], options, &option, "option",
+                JIM_ERRMSG) != JIM_OK)
+        return JIM_ERR;
+    if (option == OPT_REFCOUNT) {
         if (argc != 3) {
             Jim_WrongNumArgs(interp, 2, argv, "object");
             return JIM_ERR;
         }
         Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
         return JIM_OK;
-    } else if (!strcmp(subcommand, "objcount")) {
+    } else if (option == OPT_OBJCOUNT) {
         int freeobj = 0, liveobj = 0;
         char buf[256];
         Jim_Obj *objPtr;
@@ -8015,7 +8210,7 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
         sprintf(buf, "free %d used %d", freeobj, liveobj);
         Jim_SetResultString(interp, buf, -1);
         return JIM_OK;
-    } else if (!strcmp(subcommand, "objects")) {
+    } else if (option == OPT_OBJECTS) {
         Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
         /* Count the number of live objects. */
         objPtr = interp->liveList;
@@ -8038,7 +8233,7 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
         }
         Jim_SetResult(interp, listObjPtr);
         return JIM_OK;
-    } else if (!strcmp(subcommand, "invstr")) {
+    } else if (option == OPT_INVSTR) {
         Jim_Obj *objPtr;
 
         if (argc != 3) {
@@ -8050,6 +8245,26 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
             Jim_InvalidateStringRep(objPtr);
         Jim_SetEmptyResult(interp);
         return JIM_OK;
+    } else if (option == OPT_SCRIPTLEN) {
+        ScriptObj *script;
+        if (argc != 3) {
+            Jim_WrongNumArgs(interp, 2, argv, "script");
+            return JIM_ERR;
+        }
+        script = Jim_GetScript(interp, argv[2]);
+        Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
+        return JIM_OK;
+    } else if (option == OPT_EXPRLEN) {
+        ExprByteCode *expr;
+        if (argc != 3) {
+            Jim_WrongNumArgs(interp, 2, argv, "expression");
+            return JIM_ERR;
+        }
+        expr = Jim_GetExpression(interp, argv[2]);
+        if (expr == NULL)
+            return JIM_ERR;
+        Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
+        return JIM_OK;
     } else {
         Jim_SetResultString(interp,
             "bad option. Valid options are refcount, "
diff --git a/regtest.tcl b/regtest.tcl
index b8edf00..c1aeac3 100644
--- a/regtest.tcl
+++ b/regtest.tcl
@@ -30,6 +30,11 @@ proc fibonacci {x} {
 fibonacci 6
 puts "TEST 4 PASSED"
 
+# REGTEST 5
+# 06Mar2005 - This looped forever...
+for {set i 0} {$i < 10} {incr i} {continue}
+puts "TEST 5 PASSED"
+
 # TAKE THE FOLLOWING puts AS LAST LINE
 
 puts "--- ALL TESTS PASSED ---"
diff --git a/test.tcl b/test.tcl
index 920c5b3..2e8f5d2 100644
--- a/test.tcl
+++ b/test.tcl
@@ -1,4 +1,4 @@
-# $Id: test.tcl,v 1.16 2005/03/05 09:34:13 antirez Exp $
+# $Id: test.tcl,v 1.17 2005/03/06 22:42:33 antirez Exp $
 #
 # This are Tcl tests imported into Jim. Tests that will probably not be passed
 # in the long term are usually removed (for example all the tests about
@@ -2644,6 +2644,403 @@ test switch-10.9 {callback matches first if pat < str} {
 } 2
 
 ################################################################################
+# FOR
+################################################################################
+
+# Basic "for" operation.
+
+test for-1.1 {TclCompileForCmd: missing initial command} {
+    list [catch {for} msg] $msg
+} {1 {wrong # args: should be "for start test next body"}}
+test for-1.2 {TclCompileForCmd: error in initial command} {
+    list [catch {for {set}} msg] $msg
+} {1 {wrong # args: should be "for start test next body"}}
+catch {unset i}
+test for-1.3 {TclCompileForCmd: missing test expression} {
+    catch {for {set i 0}} msg
+    set msg
+} {wrong # args: should be "for start test next body"}
+test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
+    set i 0
+    for {} "$i > 5" {incr i} {}
+} {}
+test for-1.6 {TclCompileForCmd: missing "next" command} {
+    catch {for {set i 0} {$i < 5}} msg
+    set msg
+} {wrong # args: should be "for start test next body"}
+test for-1.7 {TclCompileForCmd: missing command body} {
+    catch {for {set i 0} {$i < 5} {incr i}} msg
+    set msg
+} {wrong # args: should be "for start test next body"}
+catch {unset a}
+test for-1.9 {TclCompileForCmd: simple command body} {
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==4 break
+	set a [concat $a $i]
+    }
+    set a
+} {1 2 3}
+test for-1.10 {TclCompileForCmd: command body in quotes} {
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
+    set a
+} {xxxxx}
+test for-1.11 {TclCompileForCmd: computed command body} {
+    catch {unset x1}
+    catch {unset bb}
+    catch {unset x2}
+    set x1 {append a x1; }
+    set bb {break}
+    set x2 {; append a x2}
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
+    set a
+} {x1}
+test for-1.13 {TclCompileForCmd: long command body} {
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==4 break
+	if $i>5 continue
+        set tcl_platform(machine) i686
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	set a [concat $a $i]
+    }
+    set a
+} {1 2 3}
+test for-1.14 {TclCompileForCmd: for command result} {
+    set a [for {set i 0} {$i < 5} {incr i} {}]
+    set a
+} {}
+test for-1.15 {TclCompileForCmd: for command result} {
+    set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
+    set a
+} {}
+
+# Check "for" and "continue".
+
+test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
+    catch {continue foo} msg
+    set msg
+} {wrong # args: should be "continue"}
+test for-2.2 {TclCompileContinueCmd: continue result} {
+    catch continue
+} 4
+test for-2.3 {continue tests} {
+    set a {}
+    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
+	if {$i == 2} continue
+	set a [concat $a $i]
+    }
+    set a
+} {1 3 4}
+test for-2.4 {continue tests} {
+    set a {}
+    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
+	if {$i != 2} continue
+	set a [concat $a $i]
+    }
+    set a
+} {2}
+test for-2.5 {continue tests, nested loops} {
+    set msg {}
+    for {set i 1} {$i <= 4} {incr i} {
+	for {set a 1} {$a <= 2} {incr a} {
+            if {$i>=2 && $a>=2} continue
+            set msg [concat $msg "$i.$a"]
+        }
+    }
+    set msg
+} {1.1 1.2 2.1 3.1 4.1}
+test for-2.6 {continue tests, long command body} {
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==2 continue
+	if $i==4 break
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	set a [concat $a $i]
+    }
+    set a
+} {1 3}
+
+# Check "for" and "break".
+
+test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
+    catch {break foo} msg
+    set msg
+} {wrong # args: should be "break"}
+test for-3.2 {TclCompileBreakCmd: break result} {
+    catch break
+} 3
+test for-3.3 {break tests} {
+    set a {}
+    for {set i 1} {$i <= 4} {incr i} {
+	if {$i == 3} break
+	set a [concat $a $i]
+    }
+    set a
+} {1 2}
+test for-3.4 {break tests, nested loops} {
+    set msg {}
+    for {set i 1} {$i <= 4} {incr i} {
+	for {set a 1} {$a <= 2} {incr a} {
+            if {$i>=2 && $a>=2} break
+            set msg [concat $msg "$i.$a"]
+        }
+    }
+    set msg
+} {1.1 1.2 2.1 3.1 4.1}
+test for-3.5 {break tests, long command body} {
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==2 continue
+	if $i==5 break
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i == 4} break
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	set a [concat $a $i]
+    }
+    set a
+} {1 3}
+test for-4.1 {break must reset the interp result} {
+    catch {
+        set z GLOBTESTDIR/dir2/file2.c
+        if [string match GLOBTESTDIR/dir2/* $z] {
+            break
+        }
+    } j
+    set j
+} {}
+
+# Test for incorrect "double evaluation" semantics
+
+test for-5.1 {possible delayed substitution of increment command} {
+    # Increment should be 5, and lappend should always append $a
+    catch {unset a}
+    catch {unset i}
+    set a 5
+    set i {}
+    for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
+    set i
+} {1 6 11}
+
+test for-5.2 {possible delayed substitution of increment command} {
+    # Increment should be 5, and lappend should always append $a
+    catch {rename p ""}
+    proc p {} {
+	set a 5
+	set i {}
+	for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
+	set i
+    }
+    p
+} {1 6 11}
+test for-5.3 {possible delayed substitution of body command} {
+    # Increment should be $a, and lappend should always append 5
+    set a 5
+    set i {}
+    for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
+    set i
+} {5 5 5 5}
+test for-5.4 {possible delayed substitution of body command} {
+    # Increment should be $a, and lappend should always append 5
+    catch {rename p ""}
+    proc p {} {
+	set a 5
+	set i {}
+	for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
+	set i
+    }
+    p
+} {5 5 5 5}
+
+# In the following tests we need to bypass the bytecode compiler by
+# substituting the command from a variable.  This ensures that command
+# procedure is invoked directly.
+
+test for-6.1 {Tcl_ForObjCmd: number of args} {
+    set z for
+    catch {$z} msg
+    set msg
+} {wrong # args: should be "for start test next body"}
+test for-6.2 {Tcl_ForObjCmd: number of args} {
+    set z for
+    catch {$z {set i 0}} msg
+    set msg
+} {wrong # args: should be "for start test next body"}
+test for-6.3 {Tcl_ForObjCmd: number of args} {
+    set z for
+    catch {$z {set i 0} {$i < 5}} msg
+    set msg
+} {wrong # args: should be "for start test next body"}
+test for-6.4 {Tcl_ForObjCmd: number of args} {
+    set z for
+    catch {$z {set i 0} {$i < 5} {incr i}} msg
+    set msg
+} {wrong # args: should be "for start test next body"}
+test for-6.5 {Tcl_ForObjCmd: number of args} {
+    set z for
+    catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
+    set msg
+} {wrong # args: should be "for start test next body"}
+test for-6.6 {Tcl_ForObjCmd: error in initial command} {
+    set z for
+    list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg
+} {1 {wrong # args: should be "set varName ?newValue?"}}
+test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
+    set z for
+    set i 0
+    $z {set i 6} "$i > 5" {incr i} {set y $i}
+    set i
+} 6
+test for-6.10 {Tcl_ForObjCmd: simple command body} {
+    set z for
+    set a {}
+    $z {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==4 break
+	set a [concat $a $i]
+    }
+    set a
+} {1 2 3}
+test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
+    set z for
+    set a {}
+    $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
+    set a
+} {xxxxx}
+test for-6.12 {Tcl_ForObjCmd: computed command body} {
+    set z for
+    catch {unset x1}
+    catch {unset bb}
+    catch {unset x2}
+    set x1 {append a x1; }
+    set bb {break}
+    set x2 {; append a x2}
+    set a {}
+    $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
+    set a
+} {x1}
+test for-6.14 {Tcl_ForObjCmd: long command body} {
+    set z for
+    set a {}
+    $z {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==4 break
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine) eq "xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	set a [concat $a $i]
+    }
+    set a
+} {1 2 3}
+test for-6.15 {Tcl_ForObjCmd: for command result} {
+    set z for
+    set a [$z {set i 0} {$i < 5} {incr i} {}]
+    set a
+} {}
+test for-6.16 {Tcl_ForObjCmd: for command result} {
+    set z for
+    set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
+    set a
+} {}
+
+
+################################################################################
 # FINAL REPORT
 ################################################################################
 
-- 
cgit v1.1