* generic/tclCompCmds.c (TclCompileStringCmd): INST_STR_MATCH -

	Updated to Int1 instruction type and added special case to use
	INST_STR_EQ instead when no glob chars are specified in a static
	string.

	* tests/{for.test,foreach.test,if.test,while.test}:
	* generic/tclCompCmds.c (TclCompileForCmd, TclCompileForeachCmd,
	TclCompileIfCmd, TclCompileWhileCmd): Corrected the overaggressive
	compiling of loop bodies enclosed in ""s.  [Bug #219166] (msofer)

4 files changed, 92 insertions, 28 deletions

diff --git a/tests/for.test b/tests/for.test
index fe36719..95ed356 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: for.test,v 1.6 2000/04/10 17:18:59 ericm Exp $
+# RCS: @(#) $Id: for.test,v 1.7 2001/09/19 18:17:54 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -587,8 +587,8 @@ test for-4.1 {break must reset the interp result} {
 
 # 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,13 +597,35 @@ test for-5.1 {possible delayed substitution of increment command} {knownBug} {
     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
 # substituting the command from a variable.  This ensures that command
diff --git a/tests/foreach.test b/tests/foreach.test
index d753fe5..fa5b3ea 100644
--- a/tests/foreach.test
+++ b/tests/foreach.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: foreach.test,v 1.7 2001/04/07 03:17:24 msofer Exp $
+# RCS: @(#) $Id: foreach.test,v 1.8 2001/09/19 18:17:54 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -222,7 +222,7 @@ test foreach-5.5 {break tests} {
 
 # 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] "
diff --git a/tests/if.test b/tests/if.test
index b6ea1e3..5cb269d 100644
--- a/tests/if.test
+++ b/tests/if.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: if.test,v 1.5 2000/04/10 17:19:00 ericm Exp $
+# RCS: @(#) $Id: if.test,v 1.6 2001/09/19 18:17:54 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1013,34 +1013,69 @@ test if-9.1 {if cmd with namespace qualifiers} {
 
 # 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 @@ test if-10.4 {delayed substitution of else body} {knownBug} {
     "
     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
diff --git a/tests/while.test b/tests/while.test
index f34bf64..b10afdc 100644
--- a/tests/while.test
+++ b/tests/while.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: while.test,v 1.6 2000/04/10 17:19:06 ericm Exp $
+# RCS: @(#) $Id: while.test,v 1.7 2001/09/19 18:17:54 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -609,13 +609,20 @@ test while-6.5 {continue tests, long command body with computed command names} {
 
 # 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