diff options
Diffstat (limited to 'tcl8.6/tests/foreach.test')
| -rw-r--r-- | tcl8.6/tests/foreach.test | 294 |
1 files changed, 294 insertions, 0 deletions
diff --git a/tcl8.6/tests/foreach.test b/tcl8.6/tests/foreach.test new file mode 100644 index 0000000..6fd5476 --- /dev/null +++ b/tcl8.6/tests/foreach.test @@ -0,0 +1,294 @@ +# 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. + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest + namespace import -force ::tcltest::* +} + +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 o] $msg $::errorInfo +} {1 {can't set "a": variable is array} {can't set "a": variable is array + (setting foreach loop variable "a") + invoked from within +"foreach a {1 2 3} {}"}} +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} + lsort [foo x] +} [lsort {{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-5.1 {continue tests} {catch continue} 4 +test foreach-5.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-5.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-5.4 {continue tests} {catch {continue foo} msg} 1 +test foreach-5.5 {continue tests} { + catch {continue foo} msg + set msg +} {wrong # args: should be "continue"} + +# Check "break". + +test foreach-6.1 {break tests} {catch break} 3 +test foreach-6.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-6.3 {break tests} {catch {break foo} msg} 1 +test foreach-6.4 {break tests} { + catch {break foo} msg + set msg +} {wrong # args: should be "break"} +# Check for bug #406709 +test foreach-6.5 {break tests} { + proc a {} { + set a 1 + foreach b b {list [concat a; break]; incr a} + incr a + } + a +} {2} + +# Test for incorrect "double evaluation" semantics +test foreach-7.1 {delayed substitution of body} { + proc foo {} { + set a 0 + foreach a [list 1 2 3] " + set x $a + " + set x + } + foo +} {0} + +# Test for [Bug 1189274]; crash on failure +test foreach-8.1 {empty list handling} { + proc crash {} { + rename crash {} + set a "x y z" + set b "" + foreach aa $a bb $b { set x "aa = $aa bb = $bb" } + } + crash +} {} + +# [Bug 1671138]; infinite loop with empty var list in bytecompiled version +test foreach-9.1 {compiled empty var list} { + proc foo {} { + foreach {} x { + error "reached body" + } + } + list [catch { foo } msg] $msg +} {1 {foreach varlist is empty}} + +test foreach-9.2 {line numbers} -setup { + proc linenumber {} {dict get [info frame -1] line} +} -body { + apply {n { + foreach x y {*}{ + } {return [incr n -[linenumber]]} + }} [linenumber] +} -cleanup { + rename linenumber {} +} -result 1 + +test foreach-10.1 {foreach: [Bug 1671087]} -setup { + proc demo {} { + set vals {1 2 3 4} + trace add variable x write {string length $vals ;# } + foreach {x y} $vals {format $y} + } +} -body { + demo +} -cleanup { + rename demo {} +} -result {} + +test foreach-11.1 {error then dereference loop var (dev bug)} { + catch { foreach a 0 b {1 2 3} { error x } } + set a +} 0 +test foreach-11.2 {error then dereference loop var (dev bug)} { + catch { foreach a 0 b {1 2 3} { incr a $b; error x } } + set a +} 1 + +# cleanup +catch {unset a} +catch {unset x} +catch {rename foo {}} +::tcltest::cleanupTests +return |