Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.582
diff -u -r1.582 ChangeLog
--- ChangeLog	2001/09/07 02:43:11	1.582
+++ ChangeLog	2001/09/07 13:02:45
@@ -1,3 +1,14 @@
+2001-09-07  Miguel Sofer  <msofer@users.sourceforge.net>
+
+	* generic/tclCompCmds.c (TclCompileForCmd, TclCompileForeachCmd,
+	TclCompileIfCmd, TclCompileWhileCmd):
+	* tests/for.test:
+	* tests/foreach.test:
+	* tests/if.test
+	* tests/while.test: Forced outline compiling when compiling the
+	commands could cause substitution errors - the "simple minded
+	solution" mentioned by Scott Stanton in [Bug 219166].
+
 2001-09-06  Don Porter  <dgp@users.sourceforge.net>
 
 	* doc/http.n:
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.13
diff -u -r1.13 tclCompCmds.c
--- generic/tclCompCmds.c	2001/09/01 00:51:31	1.13
+++ generic/tclCompCmds.c	2001/09/07 13:02:46
@@ -561,6 +561,18 @@
     }
 
     /*
+     * Bail out also if the body or the next expression require substitutions
+     * in order to insure correct behaviour [Bug 219166]
+     */
+
+    nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+    bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
+    if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) 
+	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
+	return TCL_OUT_LINE_COMPILE;
+    }
+
+    /*
      * Create ExceptionRange records for the body and the "next" command.
      * The "next" command's ExceptionRange supports break but not continue
      * (and has a -1 continueOffset).
@@ -609,8 +621,6 @@
      * Compile the loop body.
      */
 
-    nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
-    bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
     envPtr->exceptArrayPtr[bodyRange].codeOffset =
 	    (envPtr->codeNext - envPtr->codeStart);
     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
@@ -805,6 +815,19 @@
     }
 
     /*
+     * Bail out if the body requires substitutions
+     * in order to insure correct behaviour [Bug 219166]
+     */
+    for (i = 0, tokenPtr = parsePtr->tokenPtr;
+	    i < numWords-1;
+	    i++, tokenPtr += (tokenPtr->numComponents + 1)) {
+    }
+    bodyTokenPtr = tokenPtr;
+    if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_OUT_LINE_COMPILE;
+    }
+
+    /*
      * Allocate storage for the varcList and varvList arrays if necessary.
      */
 
@@ -946,7 +969,6 @@
 	    loopIndex++;
 	}
     }
-    bodyTokenPtr = tokenPtr;
 
     /*
      * Initialize the temporary var that holds the count of loop iterations.
@@ -1195,6 +1217,23 @@
     char *word;
     char buffer[100];
 
+    /*
+     * Only compile the "if" command if all arguments are simple
+     * words, in order to insure correct substitution [Bug 219166]
+     */
+
+    tokenPtr = parsePtr->tokenPtr;
+    wordIdx = 0;
+    numWords = parsePtr->numWords;
+
+    for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_OUT_LINE_COMPILE;
+	}
+	tokenPtr += 2;
+    }
+
+
     TclInitJumpFixupArray(&jumpFalseFixupArray);
     TclInitJumpFixupArray(&jumpEndFixupArray);
     maxDepth = 0;
@@ -1207,7 +1246,6 @@
 
     tokenPtr = parsePtr->tokenPtr;
     wordIdx = 0;
-    numWords = parsePtr->numWords;
     while (wordIdx < numWords) {
 	/*
 	 * Stop looping if the token isn't "if" or "elseif".
@@ -2511,11 +2549,16 @@
      * If the test expression requires substitutions, don't compile the
      * while command inline. E.g., the expression might cause the loop to
      * never execute or execute forever, as in "while "$x < 5" {}".
+     *
+     * Bail out also if the body expression requires substitutions
+     * in order to insure correct behaviour [Bug 219166]
      */
 
     testTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
-    if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+    bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+    if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) 
+	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
 	return TCL_OUT_LINE_COMPILE;
     }
 
Index: tests/for.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/for.test,v
retrieving revision 1.6
diff -u -r1.6 for.test
--- tests/for.test	2000/04/10 17:18:59	1.6
+++ tests/for.test	2001/09/07 13:02:47
@@ -587,8 +587,8 @@
 
 # Test for incorrect "double evaluation" semantics
 
-test for-5.1 {possible delayed substitution of increment command} {knownBug} {
-    # Increment should be 5, and lappend should always append 5
+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
@@ -597,12 +597,34 @@
     set i
 } {1 6 11}
 
-test for-5.2 {possible delayed substitution of body command} {knownBug} {
-    # Increment should be 5, and lappend should always append 5
+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
Index: tests/foreach.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/foreach.test,v
retrieving revision 1.7
diff -u -r1.7 foreach.test
--- tests/foreach.test	2001/04/07 03:17:24	1.7
+++ tests/foreach.test	2001/09/07 13:02:47
@@ -222,7 +222,7 @@
 
 # Test for incorrect "double evaluation" semantics
 
-test foreach-6.1 {delayed substitution of body} {knownBug} {
+test foreach-6.1 {delayed substitution of body} {
     proc foo {} {
        set a 0
        foreach a [list 1 2 3] "
Index: tests/if.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/if.test,v
retrieving revision 1.5
diff -u -r1.5 if.test
--- tests/if.test	2000/04/10 17:19:00	1.5
+++ tests/if.test	2001/09/07 13:02:47
@@ -1013,34 +1013,69 @@
 
 # Test for incorrect "double evaluation semantics"
 
-test if-10.1 {delayed substitution of then body} {knownBug} {
+test if-10.1 {delayed substitution of then body} {
     set j 0
-    if {[incr j] == 1} "
+    set if if
+    # this is not compiled
+    $if {[incr j] == 1} "
        set result $j
     "
-    set result
-} {0}
-test if-10.2 {delayed substitution of elseif expression} {knownBug} {
+    # this will be compiled
+    proc p {} {
+	set j 0
+	if {[incr j]} "
+	    set result $j
+	"
+	set result
+    }
+    append result [p]
+} {00}
+test if-10.2 {delayed substitution of elseif expression} {
     set j 0
-    if {[incr j] == 0} {
+    set if if
+    # this is not compiled
+    $if {[incr j] == 0} {
        set result badthen
     } elseif "$j == 1" {
        set result badelseif
     } else {
-       set result ok
+       set result 0
     }
-    set result
-} {ok}
-test if-10.3 {delayed substitution of elseif body} {knownBug} {
+    # this will be compiled
+    proc p {} {
+	set j 0
+	if {[incr j] == 0} {
+	    set result badthen
+	} elseif "$j == 1" {
+	    set result badelseif
+	} else {
+	    set result 0
+	}
+	set result
+    }
+    append result [p]
+} {00}
+test if-10.3 {delayed substitution of elseif body} {
     set j 0
-    if {[incr j] == 0} {
+    set if if
+    # this is not compiled
+    $if {[incr j] == 0} {
        set result badthen
     } elseif {1} "
        set result $j
     "
-    set result
-} {0}
-test if-10.4 {delayed substitution of else body} {knownBug} {
+    # this will be compiled
+    proc p {} {
+	set j 0
+	if {[incr j] == 0} {
+	    set result badthen
+	} elseif {1} "
+	    set result $j
+	"
+    }
+    append result [p]
+} {00}
+test if-10.4 {delayed substitution of else body} {
     set j 0
     if {[incr j] == 0} {
        set result badthen
@@ -1049,13 +1084,13 @@
     "
     set result
 } {0}
-test if-10.5 {substituted control words} {knownBug} {
+test if-10.5 {substituted control words} {
     set then then; proc then {} {return badthen}
     set else else; proc else {} {return badelse}
     set elseif elseif; proc elseif {} {return badelseif}
     list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a
 } {0 ok}
-test if-10.6 {double invocation of variable traces} {knownBug} {
+test if-10.6 {double invocation of variable traces} {
     set iftracecounter 0
     proc iftraceproc {args} {
        upvar #0 iftracecounter counter
Index: tests/while.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/while.test,v
retrieving revision 1.6
diff -u -r1.6 while.test
--- tests/while.test	2000/04/10 17:19:06	1.6
+++ tests/while.test	2001/09/07 13:02:47
@@ -609,13 +609,20 @@
 
 # Test for incorrect "double evaluation" semantics
 
-test while-7.1 {delayed substitution of body} {knownBug} {
+test while-7.1 {delayed substitution of body} {
     set i 0
     while {[incr i] < 10} "
        set result $i
     "
-    set result
-} {0}
+    proc p {} {
+	set i 0
+	while {[incr i] < 10} "
+	    set result $i
+	"
+	set result
+    }
+    append result [p]
+} {00}
 
 # cleanup
 ::tcltest::cleanupTests
