1# Commands covered: foreach, continue, break 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright © 1991-1993 The Regents of the University of California. 8# Copyright © 1994-1997 Sun Microsystems, Inc. 9# 10# See the file "license.terms" for information on usage and redistribution 11# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 13if {"::tcltest" ni [namespace children]} { 14 package require tcltest 2.5 15 namespace import -force ::tcltest::* 16} 17 18catch {unset a} 19catch {unset x} 20 21# Basic "foreach" operation. 22 23test foreach-1.1 {basic foreach tests} { 24 set a {} 25 foreach i {a b c d} { 26 set a [concat $a $i] 27 } 28 set a 29} {a b c d} 30test foreach-1.2 {basic foreach tests} { 31 set a {} 32 foreach i {a b {{c d} e} {123 {{x}}}} { 33 set a [concat $a $i] 34 } 35 set a 36} {a b {c d} e 123 {{x}}} 37test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1 38test foreach-1.4 {basic foreach tests} { 39 catch {foreach} msg 40 set msg 41} {wrong # args: should be "foreach varList list ?varList list ...? command"} 42test foreach-1.5 {basic foreach tests} {catch {foreach i} msg} 1 43test foreach-1.6 {basic foreach tests} { 44 catch {foreach i} msg 45 set msg 46} {wrong # args: should be "foreach varList list ?varList list ...? command"} 47test foreach-1.7 {basic foreach tests} {catch {foreach i j} msg} 1 48test foreach-1.8 {basic foreach tests} { 49 catch {foreach i j} msg 50 set msg 51} {wrong # args: should be "foreach varList list ?varList list ...? command"} 52test foreach-1.9 {basic foreach tests} {catch {foreach i j k l} msg} 1 53test foreach-1.10 {basic foreach tests} { 54 catch {foreach i j k l} msg 55 set msg 56} {wrong # args: should be "foreach varList list ?varList list ...? command"} 57test foreach-1.11 {basic foreach tests} { 58 set a {} 59 foreach i {} { 60 set a [concat $a $i] 61 } 62 set a 63} {} 64test foreach-1.12 {foreach errors} { 65 list [catch {foreach {{a}{b}} {1 2 3} {}} msg] $msg 66} {1 {list element in braces followed by "{b}" instead of space}} 67test foreach-1.13 {foreach errors} { 68 list [catch {foreach a {{1 2}3} {}} msg] $msg 69} {1 {list element in braces followed by "3" instead of space}} 70catch {unset a} 71test foreach-1.14 {foreach errors} { 72 catch {unset a} 73 set a(0) 44 74 list [catch {foreach a {1 2 3} {}} msg o] $msg $::errorInfo 75} {1 {can't set "a": variable is array} {can't set "a": variable is array 76 (setting foreach loop variable "a") 77 invoked from within 78"foreach a {1 2 3} {}"}} 79test foreach-1.15 {foreach errors} { 80 list [catch {foreach {} {} {}} msg] $msg 81} {1 {foreach varlist is empty}} 82catch {unset a} 83 84test foreach-2.1 {parallel foreach tests} { 85 set x {} 86 foreach {a b} {1 2 3 4} { 87 append x $b $a 88 } 89 set x 90} {2143} 91test foreach-2.2 {parallel foreach tests} { 92 set x {} 93 foreach {a b} {1 2 3 4 5} { 94 append x $b $a 95 } 96 set x 97} {21435} 98test foreach-2.3 {parallel foreach tests} { 99 set x {} 100 foreach a {1 2 3} b {4 5 6} { 101 append x $b $a 102 } 103 set x 104} {415263} 105test foreach-2.4 {parallel foreach tests} { 106 set x {} 107 foreach a {1 2 3} b {4 5 6 7 8} { 108 append x $b $a 109 } 110 set x 111} {41526378} 112test foreach-2.5 {parallel foreach tests} { 113 set x {} 114 foreach {a b} {a b A B aa bb} c {c C cc CC} { 115 append x $a $b $c 116 } 117 set x 118} {abcABCaabbccCC} 119test foreach-2.6 {parallel foreach tests} { 120 set x {} 121 foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} { 122 append x $a $b $c $d $e 123 } 124 set x 125} {111112222233333} 126test foreach-2.7 {parallel foreach tests} { 127 set x {} 128 foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { 129 append x $a $b $c $d $e 130 } 131 set x 132} {1111 2222334} 133test foreach-2.8 {foreach only sets vars if repeating loop} { 134 proc foo {} { 135 set rgb {65535 0 0} 136 foreach {r g b} [set rgb] {} 137 return "r=$r, g=$g, b=$b" 138 } 139 foo 140} {r=65535, g=0, b=0} 141test foreach-2.9 {foreach only supports local scalar variables} { 142 proc foo {} { 143 set x {} 144 foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]} 145 set x 146 } 147 foo 148} {1 2 3 4} 149 150test foreach-3.1 {compiled foreach backward jump works correctly} { 151 catch {unset x} 152 proc foo {arrayName} { 153 upvar 1 $arrayName a 154 set l {} 155 foreach member [array names a] { 156 lappend l [list $member [set a($member)]] 157 } 158 return $l 159 } 160 array set x {0 zero 1 one 2 two 3 three} 161 lsort [foo x] 162} [lsort {{0 zero} {1 one} {2 two} {3 three}}] 163 164test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} { 165 catch {unset x} 166 foreach {12.0} {a b c} { 167 set x 12.0 168 set x [expr {$x + 1}] 169 } 170 set x 171} 13.0 172 173# Check "continue". 174 175test foreach-5.1 {continue tests} {catch continue} 4 176test foreach-5.2 {continue tests} { 177 set a {} 178 foreach i {a b c d} { 179 if {[string compare $i "b"] == 0} continue 180 set a [concat $a $i] 181 } 182 set a 183} {a c d} 184test foreach-5.3 {continue tests} { 185 set a {} 186 foreach i {a b c d} { 187 if {[string compare $i "b"] != 0} continue 188 set a [concat $a $i] 189 } 190 set a 191} {b} 192test foreach-5.4 {continue tests} {catch {continue foo} msg} 1 193test foreach-5.5 {continue tests} { 194 catch {continue foo} msg 195 set msg 196} {wrong # args: should be "continue"} 197 198# Check "break". 199 200test foreach-6.1 {break tests} {catch break} 3 201test foreach-6.2 {break tests} { 202 set a {} 203 foreach i {a b c d} { 204 if {[string compare $i "c"] == 0} break 205 set a [concat $a $i] 206 } 207 set a 208} {a b} 209test foreach-6.3 {break tests} {catch {break foo} msg} 1 210test foreach-6.4 {break tests} { 211 catch {break foo} msg 212 set msg 213} {wrong # args: should be "break"} 214# Check for bug #406709 215test foreach-6.5 {break tests} -body { 216 proc a {} { 217 set a 1 218 foreach b b {list [concat a; break]; incr a} 219 incr a 220 } 221 a 222} -cleanup { 223 rename a {} 224} -result {2} 225 226# Test for incorrect "double evaluation" semantics 227test foreach-7.1 {delayed substitution of body} { 228 proc foo {} { 229 set a 0 230 foreach a [list 1 2 3] " 231 set x $a 232 " 233 set x 234 } 235 foo 236} {0} 237 238# Test for [Bug 1189274]; crash on failure 239test foreach-8.1 {empty list handling} { 240 proc crash {} { 241 rename crash {} 242 set a "x y z" 243 set b "" 244 foreach aa $a bb $b { set x "aa = $aa bb = $bb" } 245 } 246 crash 247} {} 248 249# [Bug 1671138]; infinite loop with empty var list in bytecompiled version 250test foreach-9.1 {compiled empty var list} { 251 proc foo {} { 252 foreach {} x { 253 error "reached body" 254 } 255 } 256 list [catch { foo } msg] $msg 257} {1 {foreach varlist is empty}} 258 259test foreach-9.2 {line numbers} -setup { 260 proc linenumber {} {dict get [info frame -1] line} 261} -body { 262 apply {n { 263 foreach x y {*}{ 264 } {return [incr n -[linenumber]]} 265 }} [linenumber] 266} -cleanup { 267 rename linenumber {} 268} -result 1 269 270test foreach-10.1 {foreach: [Bug 1671087]} -setup { 271 proc demo {} { 272 set vals {1 2 3 4} 273 trace add variable x write {string length $vals ;# } 274 foreach {x y} $vals {format $y} 275 } 276} -body { 277 demo 278} -cleanup { 279 rename demo {} 280} -result {} 281 282test foreach-11.1 {error then dereference loop var (dev bug)} { 283 catch { foreach a 0 b {1 2 3} { error x } } 284 set a 285} 0 286test foreach-11.2 {error then dereference loop var (dev bug)} { 287 catch { foreach a 0 b {1 2 3} { incr a $b; error x } } 288 set a 289} 1 290 291# cleanup 292catch {unset a} 293catch {unset x} 294catch {rename foo {}} 295::tcltest::cleanupTests 296return 297