1 files changed, 212 insertions, 0 deletions
diff --git a/tcl/tests/foreach.test b/tcl/tests/foreach.test
new file mode 100644
index 00000000000..4eca220186b
--- /dev/null
+++ b/tcl/tests/foreach.test
@@ -0,0 +1,212 @@
+# Commands covered:  foreach, continue, break
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {unset a}
+catch {unset x}
+
+# Basic "foreach" operation.
+
+test foreach-1.1 {basic foreach tests} {
+    set a {}
+    foreach i {a b c d} {
+	set a [concat $a $i]
+    }
+    set a
+} {a b c d}
+test foreach-1.2 {basic foreach tests} {
+    set a {}
+    foreach i {a b {{c d} e} {123 {{x}}}} {
+	set a [concat $a $i]
+    }
+    set a
+} {a b {c d} e 123 {{x}}}
+test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1
+test foreach-1.4 {basic foreach tests} {
+    catch {foreach} msg
+    set msg
+} {wrong # args: should be "foreach varList list ?varList list ...? command"}
+test foreach-1.5 {basic foreach tests} {catch {foreach i} msg} 1
+test foreach-1.6 {basic foreach tests} {
+    catch {foreach i} msg
+    set msg
+} {wrong # args: should be "foreach varList list ?varList list ...? command"}
+test foreach-1.7 {basic foreach tests} {catch {foreach i j} msg} 1
+test foreach-1.8 {basic foreach tests} {
+    catch {foreach i j} msg
+    set msg
+} {wrong # args: should be "foreach varList list ?varList list ...? command"}
+test foreach-1.9 {basic foreach tests} {catch {foreach i j k l} msg} 1
+test foreach-1.10 {basic foreach tests} {
+    catch {foreach i j k l} msg
+    set msg
+} {wrong # args: should be "foreach varList list ?varList list ...? command"}
+test foreach-1.11 {basic foreach tests} {
+    set a {}
+    foreach i {} {
+	set a [concat $a $i]
+    }
+    set a
+} {}
+test foreach-1.12 {foreach errors} {
+    list [catch {foreach {{a}{b}} {1 2 3} {}} msg] $msg
+} {1 {list element in braces followed by "{b}" instead of space}}
+test foreach-1.13 {foreach errors} {
+    list [catch {foreach a {{1 2}3} {}} msg] $msg
+} {1 {list element in braces followed by "3" instead of space}}
+catch {unset a}
+test foreach-1.14 {foreach errors} {
+    catch {unset a}
+    set a(0) 44
+    list [catch {foreach a {1 2 3} {}} msg] $msg
+} {1 {couldn't set loop variable: "a"}}
+test foreach-1.15 {foreach errors} {
+    list [catch {foreach {} {} {}} msg] $msg
+} {1 {foreach varlist is empty}}
+catch {unset a}
+
+test foreach-2.1 {parallel foreach tests} {
+    set x {}
+    foreach {a b} {1 2 3 4} {
+	append x $b $a
+    }
+    set x
+} {2143}
+test foreach-2.2 {parallel foreach tests} {
+    set x {}
+    foreach {a b} {1 2 3 4 5} {
+	append x $b $a
+    }
+    set x
+} {21435}
+test foreach-2.3 {parallel foreach tests} {
+    set x {}
+    foreach a {1 2 3} b {4 5 6} {
+	append x $b $a
+    }
+    set x
+} {415263}
+test foreach-2.4 {parallel foreach tests} {
+    set x {}
+    foreach a {1 2 3} b {4 5 6 7 8} {
+	append x $b $a
+    }
+    set x
+} {41526378}
+test foreach-2.5 {parallel foreach tests} {
+    set x {}
+    foreach {a b} {a b A B aa bb} c {c C cc CC} {
+	append x $a $b $c
+    }
+    set x
+} {abcABCaabbccCC}
+test foreach-2.6 {parallel foreach tests} {
+    set x {}
+    foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
+	append x $a $b $c $d $e
+    }
+    set x
+} {111112222233333}
+test foreach-2.7 {parallel foreach tests} {
+    set x {}
+    foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+	append x $a $b $c $d $e
+    }
+    set x
+} {1111 2222334}
+test foreach-2.8 {foreach only sets vars if repeating loop} {
+    proc foo {} {
+        set rgb {65535 0 0}
+        foreach {r g b} [set rgb] {}
+        return "r=$r, g=$g, b=$b"
+    }
+    foo
+} {r=65535, g=0, b=0}
+test foreach-2.9 {foreach only supports local scalar variables} {
+    proc foo {} {
+        set x {}
+        foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]}
+        set x
+    }
+    foo
+} {1 2 3 4}
+
+test foreach-3.1 {compiled foreach backward jump works correctly} {
+    catch {unset x}
+    proc foo {arrayName} {
+        upvar 1 $arrayName a
+        set l {}
+        foreach member [array names a] {
+            lappend l [list $member [set a($member)]]
+        }
+        return $l
+    }
+    array set x {0 zero 1 one 2 two 3 three}
+    foo x
+} {{0 zero} {1 one} {2 two} {3 three}}
+
+test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
+    catch {unset x}
+    foreach {12.0} {a b c} {
+        set x 12.0  
+        set x [expr $x + 1]
+    }
+    set x
+} 13.0
+
+# Check "continue".
+
+test foreach-4.1 {continue tests} {catch continue} 4
+test foreach-4.2 {continue tests} {
+    set a {}
+    foreach i {a b c d} {
+	if {[string compare $i "b"] == 0} continue
+	set a [concat $a $i]
+    }
+    set a
+} {a c d}
+test foreach-4.3 {continue tests} {
+    set a {}
+    foreach i {a b c d} {
+	if {[string compare $i "b"] != 0} continue
+	set a [concat $a $i]
+    }
+    set a
+} {b}
+test foreach-4.4 {continue tests} {catch {continue foo} msg} 1
+test foreach-4.5 {continue tests} {
+    catch {continue foo} msg
+    set msg
+} {wrong # args: should be "continue"}
+
+# Check "break".
+
+test foreach-5.1 {break tests} {catch break} 3
+test foreach-5.2 {break tests} {
+    set a {}
+    foreach i {a b c d} {
+	if {[string compare $i "c"] == 0} break
+	set a [concat $a $i]
+    }
+    set a
+} {a b}
+test foreach-5.3 {break tests} {catch {break foo} msg} 1
+test foreach-5.4 {break tests} {
+    catch {break foo} msg
+    set msg
+} {wrong # args: should be "break"}
+
+catch {unset a}
+catch {unset x}