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