1# Commands covered: lmap, 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# Copyright © 2011 Trevor Davel 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13# 14# RCS: @(#) $Id: $ 15 16if {"::tcltest" ni [namespace children]} { 17 package require tcltest 2.5 18 namespace import -force ::tcltest::* 19} 20 21unset -nocomplain a b i x 22 23# ----- Non-compiled operation ----------------------------------------------- 24 25# Basic "lmap" operation (non-compiled) 26test lmap-1.1 {basic lmap tests} { 27 set a {} 28 lmap i {a b c d} { 29 set a [concat $a $i] 30 } 31} {a {a b} {a b c} {a b c d}} 32test lmap-1.2 {basic lmap tests} { 33 lmap i {a b {{c d} e} {123 {{x}}}} { 34 set i 35 } 36} {a b {{c d} e} {123 {{x}}}} 37test lmap-1.2a {basic lmap tests} { 38 lmap i {a b {{c d} e} {123 {{x}}}} { 39 return -level 0 $i 40 } 41} {a b {{c d} e} {123 {{x}}}} 42test lmap-1.4 {basic lmap tests} -returnCodes error -body { 43 lmap 44} -result {wrong # args: should be "lmap varList list ?varList list ...? command"} 45test lmap-1.6 {basic lmap tests} -returnCodes error -body { 46 lmap i 47} -result {wrong # args: should be "lmap varList list ?varList list ...? command"} 48test lmap-1.8 {basic lmap tests} -returnCodes error -body { 49 lmap i j 50} -result {wrong # args: should be "lmap varList list ?varList list ...? command"} 51test lmap-1.10 {basic lmap tests} -returnCodes error -body { 52 lmap i j k l 53} -result {wrong # args: should be "lmap varList list ?varList list ...? command"} 54test lmap-1.11 {basic lmap tests} { 55 lmap i {} { 56 set i 57 } 58} {} 59test lmap-1.12 {basic lmap tests} { 60 lmap i {} { 61 return -level 0 x 62 } 63} {} 64test lmap-1.13 {lmap errors} -returnCodes error -body { 65 lmap {{a}{b}} {1 2 3} {} 66} -result {list element in braces followed by "{b}" instead of space} 67test lmap-1.14 {lmap errors} -returnCodes error -body { 68 lmap a {{1 2}3} {} 69} -result {list element in braces followed by "3" instead of space} 70unset -nocomplain a 71test lmap-1.15 {lmap errors} -setup { 72 unset -nocomplain a 73} -body { 74 set a(0) 44 75 list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo 76} -result {1 {can't set "a": variable is array} {can't set "a": variable is array 77 (setting lmap loop variable "a") 78 invoked from within 79"lmap a {1 2 3} {}"}} 80test lmap-1.16 {lmap errors} -returnCodes error -body { 81 lmap {} {} {} 82} -result {lmap varlist is empty} 83unset -nocomplain a 84 85# Parallel "lmap" operation (non-compiled) 86test lmap-2.1 {parallel lmap tests} { 87 lmap {a b} {1 2 3 4} { 88 list $b $a 89 } 90} {{2 1} {4 3}} 91test lmap-2.2 {parallel lmap tests} { 92 lmap {a b} {1 2 3 4 5} { 93 list $b $a 94 } 95} {{2 1} {4 3} {{} 5}} 96test lmap-2.3 {parallel lmap tests} { 97 lmap a {1 2 3} b {4 5 6} { 98 list $b $a 99 } 100} {{4 1} {5 2} {6 3}} 101test lmap-2.4 {parallel lmap tests} { 102 lmap a {1 2 3} b {4 5 6 7 8} { 103 list $b $a 104 } 105} {{4 1} {5 2} {6 3} {7 {}} {8 {}}} 106test lmap-2.5 {parallel lmap tests} { 107 lmap {a b} {a b A B aa bb} c {c C cc CC} { 108 list $a $b $c 109 } 110} {{a b c} {A B C} {aa bb cc} {{} {} CC}} 111test lmap-2.6 {parallel lmap tests} { 112 lmap a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} { 113 list $a$b$c$d$e 114 } 115} {11111 22222 33333} 116test lmap-2.7 {parallel lmap tests} { 117 lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { 118 set x $a$b$c$d$e 119 } 120} {{1111 2} 222 33 4} 121test lmap-2.8 {parallel lmap tests} { 122 lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { 123 join [list $a $b $c $d $e] . 124 } 125} {{.1.1.1.1 2} .2.2.2. .3..3. ...4.} 126test lmap-2.9 {lmap only sets vars if repeating loop} { 127 namespace eval ::lmap_test { 128 set rgb {65535 0 0} 129 lmap {r g b} [set rgb] {} 130 set ::x "r=$r, g=$g, b=$b" 131 } 132 namespace delete ::lmap_test 133 set x 134} {r=65535, g=0, b=0} 135test lmap-2.10 {lmap only supports local scalar variables} -setup { 136 unset -nocomplain a 137} -body { 138 lmap {a(3)} {1 2 3 4} {set {a(3)}} 139} -result {1 2 3 4} 140unset -nocomplain a 141 142# "lmap" with "continue" and "break" (non-compiled) 143test lmap-3.1 {continue tests} { 144 lmap i {a b c d} { 145 if {[string compare $i "b"] == 0} continue 146 set i 147 } 148} {a c d} 149test lmap-3.2 {continue tests} { 150 set x 0 151 list [lmap i {a b c d} { 152 incr x 153 if {[string compare $i "b"] != 0} continue 154 set i 155 }] $x 156} {b 4} 157test lmap-3.3 {break tests} { 158 set x 0 159 list [lmap i {a b c d} { 160 incr x 161 if {[string compare $i "c"] == 0} break 162 set i 163 }] $x 164} {{a b} 3} 165# Check for bug similar to #406709 166test lmap-3.4 {break tests} { 167 set a 1 168 lmap b b {list [concat a; break]; incr a} 169 incr a 170} {2} 171 172# ----- Compiled operation --------------------------------------------------- 173 174# Basic "lmap" operation (compiled) 175test lmap-4.1 {basic lmap tests} { 176 apply {{} { 177 set a {} 178 lmap i {a b c d} { 179 set a [concat $a $i] 180 } 181 }} 182} {a {a b} {a b c} {a b c d}} 183test lmap-4.2 {basic lmap tests} { 184 apply {{} { 185 lmap i {a b {{c d} e} {123 {{x}}}} { 186 set i 187 } 188 }} 189} {a b {{c d} e} {123 {{x}}}} 190test lmap-4.2a {basic lmap tests} { 191 apply {{} { 192 lmap i {a b {{c d} e} {123 {{x}}}} { 193 return -level 0 $i 194 } 195 }} 196} {a b {{c d} e} {123 {{x}}}} 197test lmap-4.4 {basic lmap tests} -returnCodes error -body { 198 apply {{} { lmap }} 199} -result {wrong # args: should be "lmap varList list ?varList list ...? command"} 200test lmap-4.6 {basic lmap tests} -returnCodes error -body { 201 apply {{} { lmap i }} 202} -result {wrong # args: should be "lmap varList list ?varList list ...? command"} 203test lmap-4.8 {basic lmap tests} -returnCodes error -body { 204 apply {{} { lmap i j }} 205} -result {wrong # args: should be "lmap varList list ?varList list ...? command"} 206test lmap-4.10 {basic lmap tests} -returnCodes error -body { 207 apply {{} { lmap i j k l }} 208} -result {wrong # args: should be "lmap varList list ?varList list ...? command"} 209test lmap-4.11 {basic lmap tests} { 210 apply {{} { lmap i {} { set i } }} 211} {} 212test lmap-4.12 {basic lmap tests} { 213 apply {{} { lmap i {} { return -level 0 x } }} 214} {} 215test lmap-4.13 {lmap errors} -returnCodes error -body { 216 apply {{} { lmap {{a}{b}} {1 2 3} {} }} 217} -result {list element in braces followed by "{b}" instead of space} 218test lmap-4.14 {lmap errors} -returnCodes error -body { 219 apply {{} { lmap a {{1 2}3} {} }} 220} -result {list element in braces followed by "3" instead of space} 221unset -nocomplain a 222test lmap-4.15 {lmap errors} { 223 apply {{} { 224 set a(0) 44 225 list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo 226 }} 227} {1 {can't set "a": variable is array} {can't set "a": variable is array 228 while executing 229"lmap a {1 2 3} {}"}} 230test lmap-4.16 {lmap errors} -returnCodes error -body { 231 apply {{} { 232 lmap {} {} {} 233 }} 234} -result {lmap varlist is empty} 235unset -nocomplain a 236 237# Parallel "lmap" operation (compiled) 238test lmap-5.1 {parallel lmap tests} { 239 apply {{} { 240 lmap {a b} {1 2 3 4} { 241 list $b $a 242 } 243 }} 244} {{2 1} {4 3}} 245test lmap-5.2 {parallel lmap tests} { 246 apply {{} { 247 lmap {a b} {1 2 3 4 5} { 248 list $b $a 249 } 250 }} 251} {{2 1} {4 3} {{} 5}} 252test lmap-5.3 {parallel lmap tests} { 253 apply {{} { 254 lmap a {1 2 3} b {4 5 6} { 255 list $b $a 256 } 257 }} 258} {{4 1} {5 2} {6 3}} 259test lmap-5.4 {parallel lmap tests} { 260 apply {{} { 261 lmap a {1 2 3} b {4 5 6 7 8} { 262 list $b $a 263 } 264 }} 265} {{4 1} {5 2} {6 3} {7 {}} {8 {}}} 266test lmap-5.5 {parallel lmap tests} { 267 apply {{} { 268 lmap {a b} {a b A B aa bb} c {c C cc CC} { 269 list $a $b $c 270 } 271 }} 272} {{a b c} {A B C} {aa bb cc} {{} {} CC}} 273test lmap-5.6 {parallel lmap tests} { 274 apply {{} { 275 lmap a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} { 276 list $a$b$c$d$e 277 } 278 }} 279} {11111 22222 33333} 280test lmap-5.7 {parallel lmap tests} { 281 apply {{} { 282 lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { 283 set x $a$b$c$d$e 284 } 285 }} 286} {{1111 2} 222 33 4} 287test lmap-5.8 {parallel lmap tests} { 288 apply {{} { 289 lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { 290 join [list $a $b $c $d $e] . 291 } 292 }} 293} {{.1.1.1.1 2} .2.2.2. .3..3. ...4.} 294test lmap-5.9 {lmap only sets vars if repeating loop} { 295 apply {{} { 296 set rgb {65535 0 0} 297 lmap {r g b} [set rgb] {} 298 return "r=$r, g=$g, b=$b" 299 }} 300} {r=65535, g=0, b=0} 301test lmap-5.10 {lmap only supports local scalar variables} { 302 apply {{} { 303 lmap {a(3)} {1 2 3 4} {set {a(3)}} 304 }} 305} {1 2 3 4} 306 307# "lmap" with "continue" and "break" (compiled) 308test lmap-6.1 {continue tests} { 309 apply {{} { 310 lmap i {a b c d} { 311 if {[string compare $i "b"] == 0} continue 312 set i 313 } 314 }} 315} {a c d} 316test lmap-6.2 {continue tests} { 317 apply {{} { 318 list [lmap i {a b c d} { 319 incr x 320 if {[string compare $i "b"] != 0} continue 321 set i 322 }] $x 323 }} 324} {b 4} 325test lmap-6.3 {break tests} { 326 apply {{} { 327 list [lmap i {a b c d} { 328 incr x 329 if {[string compare $i "c"] == 0} break 330 set i 331 }] $x 332 }} 333} {{a b} 3} 334# Check for bug similar to #406709 335test lmap-6.4 {break tests} { 336 apply {{} { 337 set a 1 338 lmap b b {list [concat a; break]; incr a} 339 incr a 340 }} 341} {2} 342 343# ----- Special cases and bugs ----------------------------------------------- 344test lmap-7.1 {compiled lmap backward jump works correctly} -setup { 345 unset -nocomplain x 346} -body { 347 array set x {0 zero 1 one 2 two 3 three} 348 lsort [apply {{arrayName} { 349 upvar 1 $arrayName a 350 lmap member [array names a] { 351 list $member [set a($member)] 352 } 353 }} x] 354} -result [lsort {{0 zero} {1 one} {2 two} {3 three}}] 355test lmap-7.2 {noncompiled lmap and shared variable or value list objects that are converted to another type} -setup { 356 unset -nocomplain x 357} -body { 358 lmap {12.0} {a b c} { 359 set x 12.0 360 set x [expr {$x + 1}] 361 } 362} -result {13.0 13.0 13.0} 363# Test for incorrect "double evaluation" semantics 364test lmap-7.3 {delayed substitution of body} { 365 apply {{} { 366 set a 0 367 lmap a [list 1 2 3] " 368 set x $a 369 " 370 return $x 371 }} 372} {0} 373# Related to "foreach" test for [Bug 1189274]; crash on failure 374test lmap-7.4 {empty list handling} { 375 proc crash {} { 376 rename crash {} 377 set a "x y z" 378 set b "" 379 lmap aa $a bb $b { set x "aa = $aa bb = $bb" } 380 } 381 crash 382} {{aa = x bb = } {aa = y bb = } {aa = z bb = }} 383# Related to [Bug 1671138]; infinite loop with empty var list in bytecompiled 384# version. 385test lmap-7.5 {compiled empty var list} -returnCodes error -body { 386 proc foo {} { 387 lmap {} x { 388 error "reached body" 389 } 390 } 391 foo 392} -cleanup { 393 catch {rename foo ""} 394} -result {lmap varlist is empty} 395test lmap-7.6 {lmap: related to "foreach" [Bug 1671087]} -setup { 396 proc demo {} { 397 set vals {1 2 3 4} 398 trace add variable x write {string length $vals ;# } 399 lmap {x y} $vals {format $y} 400 } 401} -body { 402 demo 403} -cleanup { 404 rename demo {} 405} -result {2 4} 406# Huge lists must not overflow the bytecode interpreter (development bug) 407test lmap-7.7 {huge list non-compiled} -setup { 408 unset -nocomplain a b x 409} -body { 410 set x [lmap a [lrepeat 1000000 x] { set b y$a }] 411 list $b [llength $x] [string length $x] 412} -result {yx 1000000 2999999} 413test lmap-7.8 {huge list compiled} -setup { 414 unset -nocomplain a b x 415} -body { 416 set x [apply {{times} { 417 global b 418 lmap a [lrepeat $times x] { set b Y$a } 419 }} 1000000] 420 list $b [llength $x] [string length $x] 421} -result {Yx 1000000 2999999} 422test lmap-7.9 {error then dereference loop var (dev bug)} { 423 catch { lmap a 0 b {1 2 3} { error x } } 424 set a 425} 0 426test lmap-7.9a {error then dereference loop var (dev bug)} { 427 catch { lmap a 0 b {1 2 3} { incr a $b; error x } } 428 set a 429} 1 430 431# ----- Coroutines ----------------------------------------------------------- 432test lmap-8.1 {lmap non-compiled with coroutines} -body { 433 coroutine coro apply {{} { 434 set values [yield [info coroutine]] 435 eval lmap i [list $values] {{ yield $i }} 436 }} ;# returns 'coro' 437 coro {a b c d e f} ;# -> a 438 coro 1 ;# -> b 439 coro 2 ;# -> c 440 coro 3 ;# -> d 441 coro 4 ;# -> e 442 coro 5 ;# -> f 443 list [coro 6] [info commands coro] 444} -cleanup { 445 catch {rename coro ""} 446} -result {{1 2 3 4 5 6} {}} 447test lmap-8.2 {lmap compiled with coroutines} -body { 448 coroutine coro apply {{} { 449 set values [yield [info coroutine]] 450 lmap i $values { yield $i } 451 }} ;# returns 'coro' 452 coro {a b c d e f} ;# -> a 453 coro 1 ;# -> b 454 coro 2 ;# -> c 455 coro 3 ;# -> d 456 coro 4 ;# -> e 457 coro 5 ;# -> f 458 list [coro 6] [info commands coro] 459} -cleanup { 460 catch {rename coro ""} 461} -result {{1 2 3 4 5 6} {}} 462 463# cleanup 464unset -nocomplain a x 465catch {rename foo {}} 466::tcltest::cleanupTests 467return 468 469# Local Variables: 470# mode: tcl 471# End: 472