# 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: foreach.test,v 1.8.8.3 2007/03/13 16:26:33 dgp Exp $ 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] $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} 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} # [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-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 {} # cleanup catch {unset a} catch {unset x} ::tcltest::cleanupTests return