build: remove -Werror when running ./configure
[jimtcl.git] / tests / jim.test
blob9c12ac733b76db1451f625d95473822c1c8c817d
1 # $Id: test.tcl,v 1.31 2008/11/06 13:31:22 oharboe Exp $
3 # These are Tcl tests imported into Jim. Tests that will probably not be passed
4 # in the long term are usually removed (for example all the tests about
5 # unicode things, about errors in list parsing that are always valid in Jim
6 # and so on).
8 # Sometimes tests are modified to reflect different error messages.
10 source [file dirname [info script]]/testing.tcl
12 needs constraint jim
13 catch {package require regexp}
14 testConstraint regexp [expr {[info commands regexp] ne {}}]
15 testConstraint lambda [expr {[info commands ref] ne {}}]
17 ################################################################################
18 # SET
19 ################################################################################
21 test set-1.2 {TclCompileSetCmd: simple variable name} {
22     set i 10
23     list [set i] $i
24 } {10 10}
26 test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
27     set i 17
28     list [set "i"] $i
29 } {17 17}
31 test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} {
32     set x "i"
33     set i 77
34     list [set $x] $i
35 } {77 77}
37 test set-1.8 {TclCompileSetCmd: non-simple (computed) variable name} {
38     set x "i"
39     set i 77
40     list [set [set x] 2] $i
41 } {2 2}
43 test set-1.9 {TclCompileSetCmd: 3rd arg => assignment} {
44     set i "abcdef"
45     list [set i] $i
46 } {abcdef abcdef}
48 test set-1.10 {TclCompileSetCmd: only two args => just getting value} {
49     set i {one two}
50     set i
51 } {one two}
53 test set-1.11 {TclCompileSetCmd: simple global name} {
54     proc p {} {
55         global i
56         set i 54
57         set i
58     }
59     p
60 } {54}
62 test set-1.12 {TclCompileSetCmd: simple local name} {
63     proc p {bar} {
64         set foo $bar
65         set foo
66     }
67     p 999
68 } {999}
70 test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} {
71     proc 260locals {} {
72         # create 260 locals (the last ones with index > 255)
73         set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
74         set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
75         set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
76         set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
77         set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
78         set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
79         set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
80         set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
81         set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
82         set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
83         set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
84         set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
85         set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
86         set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
87         set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
88         set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
89         set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
90         set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
91         set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
92         set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
93         set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
94         set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
95         set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
96         set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
97         set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
98         set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
99         set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
100         set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
101         set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
102         set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
103         set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
104         set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
105         set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
106         set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
107         set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
108         set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
109         set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
110         set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
111         set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
112         set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
113         set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
114         set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
115         set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
116         set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
117         set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
118         set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
119         set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
120         set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
121         set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
122         set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
123         set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
124         set z5 0; set z6 0; set z7 0; set z8 0; set z9 1234
125     }
126     260locals
127 } {1234}
129 test set-1.17 {TclCompileSetCmd: doing assignment, simple int} {
130     set i 5
131     set i 123
132 } 123
134 test set-1.18 {TclCompileSetCmd: doing assignment, simple int} {
135     set i 5
136     set i -100
137 } -100
139 test set-1.19 {TclCompileSetCmd: doing assignment, simple but not int} {
140     set i 5
141     set i 0x12MNOP
142     set i
143 } {0x12MNOP}
145 test set-1.20 {TclCompileSetCmd: doing assignment, in quotes} {
146     set i 25
147     set i "-100"
148 } -100
150 test set-1.21 {TclCompileSetCmd: doing assignment, in braces} {
151     set i 24
152     set i {126}
153 } 126
155 test set-1.22 {TclCompileSetCmd: doing assignment, large int} {
156     set i 5
157     set i 200000
158 } 200000
160 test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} {
161     set i 25
162     set i 000012345     ;# a decimal literal == 5349 decimal
163     list $i [incr i]
164 } {000012345 12346}
166 ################################################################################
167 # LIST
168 ################################################################################
170 test list-1.1 {basic tests} {list a b c} {a b c}
171 test list-1.2 {basic tests} {list {a b} c} {{a b} c}
172 test list-1.3 {basic tests} {list \{a b c} {\{a b c}
173 test list-1.4 {basic tests} "list a{}} b{} c}" "a\\{\\}\\} b{} c\\}"
174 test list-1.5 {basic tests} {list a\[ b\] } "{a\[} b\\]"
175 test list-1.6 {basic tests} {list c\  d\t } "{c } {d\t}"
176 test list-1.7 {basic tests} {list e\n f\$ } "{e\n} {f\$}"
177 test list-1.8 {basic tests} {list g\; h\\} {{g;} h\\}
178 test list-1.9 {basic tests} "list a\\\[} b\\\]} " "a\\\[\\\} b\\\]\\\}"
179 test list-1.10 {basic tests} "list c\\\} d\\t} " "c\\} d\\t\\}"
180 test list-1.11 {basic tests} "list e\\n} f\\$} " "e\\n\\} f\\$\\}"
181 test list-1.12 {basic tests} "list g\\;} h\\\\} " "g\\;\\} {h\\}}"
182 test list-1.13 {basic tests} {list a {{}} b} {a {{}} b}
183 test list-1.14 {basic tests} {list a b xy\\} "a b xy\\\\"
184 test list-1.15 {basic tests} "list a b\} e\\" "a b\\} e\\\\"
185 test list-1.16 {basic tests} "list a b\}\\\$ e\\\$\\" "a b\\}\\\$ e\\\$\\\\"
186 test list-1.17 {basic tests} {list a\f \{\f} "{a\f} \\\{\\f"
187 test list-1.18 {basic tests} {list a\r \{\r} "{a\r} \\\{\\r"
188 test list-1.19 {basic tests} {list a\v \{\v} "{a\v} \\\{\\v"
189 test list-1.20 {basic tests} {list \"\}\{} "\\\"\\}\\{"
190 test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd"
191 test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\
192 test list-1.23 {basic tests} {list \{} "\\{"
193 test list-1.24 {basic tests} {list} {}
195 set num 0
196 proc lcheck {testid a b c} {
197     global num d
198     set d [list $a $b $c]
199     test ${testid}-0 {what goes in must come out} {lindex $d 0} $a
200     test ${testid}-1 {what goes in must come out} {lindex $d 1} $b
201     test ${testid}-2 {what goes in must come out} {lindex $d 2} $c
203 lcheck list-2.1  a b c
204 lcheck list-2.2  "a b" c\td e\nf
205 lcheck list-2.3  {{a b}} {} {  }
206 lcheck list-2.4  \$ \$ab ab\$
207 lcheck list-2.5  \; \;ab ab\;
208 lcheck list-2.6  \[ \[ab ab\[
209 lcheck list-2.7  \\ \\ab ab\\
210 lcheck list-2.8  {"} {"ab} {ab"}        ;#" Stupid emacs highlighting!
211 lcheck list-2.9  {a b} { ab} {ab }
212 lcheck list-2.10 a{ a{b \{ab
213 lcheck list-2.11 a} a}b }ab
214 lcheck list-2.12 a\\} {a \}b} {a \{c}
215 lcheck list-2.13 xyz \\ 1\\\n2
216 lcheck list-2.14 "{ab}\\" "{ab}xy" abc
218 concat {}
220 ################################################################################
221 # WHILE
222 ################################################################################
224 test while-1.9 {TclCompileWhileCmd: simple command body} {
225     set a {}
226     set i 1
227     while {$i<6} {
228         if $i==4 break
229         set a [concat $a $i]
230         incr i
231     }
232     set a
233 } {1 2 3}
235 test while-1.10 {TclCompileWhileCmd: command body in quotes} {
236     set a {}
237     set i 1
238     while {$i<6} "append a x; incr i"
239     set a
240 } {xxxxx}
242 test while-1.13 {TclCompileWhileCmd: while command result} {
243     set i 0
244     set a [while {$i < 5} {incr i}]
245     set a
246 } {}
248 test while-1.14 {TclCompileWhileCmd: while command result} {
249     set i 0
250     set a [while {$i < 5} {if $i==3 break; incr i}]
251     set a
252 } {}
254 test while-2.1 {continue tests} {
255     set a {}
256     set i 1
257     while {$i <= 4} {
258         incr i
259         if {$i == 3} continue
260         set a [concat $a $i]
261     }
262     set a
263 } {2 4 5}
264 test while-2.2 {continue tests} {
265     set a {}
266     set i 1
267     while {$i <= 4} {
268         incr i
269         if {$i != 2} continue
270         set a [concat $a $i]
271     }
272     set a
273 } {2}
274 test while-2.3 {continue tests, nested loops} {
275     set msg {}
276     set i 1
277     while {$i <= 4} {
278         incr i
279         set a 1
280         while {$a <= 2} {
281             incr a
282             if {$i>=3 && $a>=3} continue
283             set msg [concat $msg "$i.$a"]
284         }
285     }
286     set msg
287 } {2.2 2.3 3.2 4.2 5.2}
289 test while-4.1 {while and computed command names} {
290     set i 0
291     set z while
292     $z {$i < 10} {
293         incr i
294     }
295     set i
296 } 10
298 test while-5.2 {break tests with computed command names} {
299     set a {}
300     set i 1
301     set z break
302     while {$i <= 4} {
303         if {$i == 3} $z
304         set a [concat $a $i]
305         incr i
306     }
307     set a
308 } {1 2}
310 test while-7.1 {delayed substitution of body} {
311     set i 0
312     while {[incr i] < 10} "
313        set result $i
314     "
315     proc p {} {
316         set i 0
317         while {[incr i] < 10} "
318             set result $i
319         "
320         set result
321     }
322     append result [p]
323 } {00}
325 ################################################################################
326 # LSET
327 ################################################################################
329 set lset lset
331 test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} {
332     set x {0 1 2}
333     list [eval [list $lset x 0 3]] $x
334 } {{3 1 2} {3 1 2}}
336 test lset-3.1 {lset, not compiled, 3 args, data duplicated} {
337     set x {0 1 2}
338     list [eval [list $lset x 0 $x]] $x
339 } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
341 test lset-3.2 {lset, not compiled, 3 args, data duplicated} {
342     set x {0 1}
343     set y $x
344     list [eval [list $lset x 0 2]] $x $y
345 } {{2 1} {2 1} {0 1}}
347 test lset-3.3 {lset, not compiled, 3 args, data duplicated} {
348     set x {0 1}
349     set y $x
350     list [eval [list $lset x 0 $x]] $x $y
351 } {{{0 1} 1} {{0 1} 1} {0 1}}
353 test lset-3.4 {lset, not compiled, 3 args, data duplicated} {
354     set x {0 1 2}
355     list [eval [list $lset x [list 0] $x]] $x
356 } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
358 test lset-3.5 {lset, not compiled, 3 args, data duplicated} {
359     set x {0 1}
360     set y $x
361     list [eval [list $lset x [list 0] 2]] $x $y
362 } {{2 1} {2 1} {0 1}}
364 test lset-3.6 {lset, not compiled, 3 args, data duplicated} {
365     set x {0 1}
366     set y $x
367     list [eval [list $lset x [list 0] $x]] $x $y
368 } {{{0 1} 1} {{0 1} 1} {0 1}}
370 test lset-4.2 {lset, not compiled, 3 args, bad index} {
371     set a {x y z}
372     list [catch {
373         eval [list $lset a [list 2a2] w]
374     } msg] $msg
375 } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
377 test lset-4.3 {lset, not compiled, 3 args, index out of range} {
378     set a {x y z}
379     list [catch {
380         eval [list $lset a [list -1] w]
381     } msg] $msg
382 } {1 {list index out of range}}
384 test lset-4.4 {lset, not compiled, 3 args, index out of range} {
385     set a {x y z}
386     list [catch {
387         eval [list $lset a [list 3] w]
388     } msg] $msg
389 } {1 {list index out of range}}
391 test lset-4.5 {lset, not compiled, 3 args, index out of range} {
392     set a {x y z}
393     list [catch {
394         eval [list $lset a [list end--1] w]
395     } msg] $msg
396 } {1 {list index out of range}}
398 test lset-4.6 {lset, not compiled, 3 args, index out of range} {
399     set a {x y z}
400     list [catch {
401         eval [list $lset a [list end-3] w]
402     } msg] $msg
403 } {1 {list index out of range}}
405 test lset-4.8 {lset, not compiled, 3 args, bad index} {
406     set a {x y z}
407     list [catch {
408         eval [list $lset a 2a2 w]
409     } msg] $msg
410 } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
412 test lset-4.9 {lset, not compiled, 3 args, index out of range} {
413     set a {x y z}
414     list [catch {
415         eval [list $lset a -1 w]
416     } msg] $msg
417 } {1 {list index out of range}}
419 test lset-4.10 {lset, not compiled, 3 args, index out of range} {
420     set a {x y z}
421     list [catch {
422         eval [list $lset a 3 w]
423     } msg] $msg
424 } {1 {list index out of range}}
426 test lset-4.11 {lset, not compiled, 3 args, index out of range} {
427     set a {x y z}
428     list [catch {
429         eval [list $lset a end--1 w]
430     } msg] $msg
431 } {1 {list index out of range}}
433 test lset-4.12 {lset, not compiled, 3 args, index out of range} {
434     set a {x y z}
435     list [catch {
436         eval [list $lset a end-3 w]
437     } msg] $msg
438 } {1 {list index out of range}}
440 test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} {
441     set a {x y z}
442     list [eval [list $lset a 0 a]] $a
443 } {{a y z} {a y z}}
445 test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} {
446     set a {x y z}
447     list [eval [list $lset a [list 0] a]] $a
448 } {{a y z} {a y z}}
450 test lset-6.3 {lset, not compiled, 1-d list basics} {
451     set a {x y z}
452     list [eval [list $lset a 2 a]] $a
453 } {{x y a} {x y a}}
455 test lset-6.4 {lset, not compiled, 1-d list basics} {
456     set a {x y z}
457     list [eval [list $lset a [list 2] a]] $a
458 } {{x y a} {x y a}}
460 test lset-6.5 {lset, not compiled, 1-d list basics} {
461     set a {x y z}
462     list [eval [list $lset a end a]] $a
463 } {{x y a} {x y a}}
465 test lset-6.6 {lset, not compiled, 1-d list basics} {
466     set a {x y z}
467     list [eval [list $lset a [list end] a]] $a
468 } {{x y a} {x y a}}
470 test lset-6.7 {lset, not compiled, 1-d list basics} {
471     set a {x y z}
472     list [eval [list $lset a end-0 a]] $a
473 } {{x y a} {x y a}}
475 test lset-6.8 {lset, not compiled, 1-d list basics} {
476     set a {x y z}
477     list [eval [list $lset a [list end-0] a]] $a
478 } {{x y a} {x y a}}
479 test lset-6.9 {lset, not compiled, 1-d list basics} {
480     set a {x y z}
481     list [eval [list $lset a end-2 a]] $a
482 } {{a y z} {a y z}}
484 test lset-6.10 {lset, not compiled, 1-d list basics} {
485     set a {x y z}
486     list [eval [list $lset a [list end-2] a]] $a
487 } {{a y z} {a y z}}
489 test lset-7.1 {lset, not compiled, data sharing} {
490     set a 0
491     list [eval [list $lset a $a {gag me}]] $a
492 } {{{gag me}} {{gag me}}}
494 test lset-7.2 {lset, not compiled, data sharing} {
495     set a [list 0]
496     list [eval [list $lset a $a {gag me}]] $a
497 } {{{gag me}} {{gag me}}}
499 test lset-7.3 {lset, not compiled, data sharing} {
500     set a {x y}
501     list [eval [list $lset a 0 $a]] $a
502 } {{{x y} y} {{x y} y}}
504 test lset-7.4 {lset, not compiled, data sharing} {
505     set a {x y}
506     list [eval [list $lset a [list 0] $a]] $a
507 } {{{x y} y} {{x y} y}}
509 test lset-7.5 {lset, not compiled, data sharing} {
510     set n 0
511     set a {x y}
512     list [eval [list $lset a $n $n]] $a $n
513 } {{0 y} {0 y} 0}
515 test lset-7.6 {lset, not compiled, data sharing} {
516     set n [list 0]
517     set a {x y}
518     list [eval [list $lset a $n $n]] $a $n
519 } {{0 y} {0 y} 0}
521 test lset-7.7 {lset, not compiled, data sharing} {
522     set n 0
523     set a [list $n $n]
524     list [eval [list $lset a $n 1]] $a $n
525 } {{1 0} {1 0} 0}
527 test lset-7.8 {lset, not compiled, data sharing} {
528     set n [list 0]
529     set a [list $n $n]
530     list [eval [list $lset a $n 1]] $a $n
531 } {{1 0} {1 0} 0}
533 test lset-7.9 {lset, not compiled, data sharing} {
534     set a 0
535     list [eval [list $lset a $a $a]] $a
536 } {0 0}
538 test lset-7.10 {lset, not compiled, data sharing} {
539     set a [list 0]
540     list [eval [list $lset a $a $a]] $a
541 } {0 0}
543 test lset-8.3 {lset, not compiled, bad second index} {
544     set a {{b c} {d e}}
545     list [catch {eval [list $lset a 0 2a2 f]} msg] $msg
546 } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
548 test lset-8.5 {lset, not compiled, second index out of range} {
549     set a {{b c} {d e} {f g}}
550     list [catch {eval [list $lset a 2 -1 h]} msg] $msg
551 } {1 {list index out of range}}
553 test lset-8.7 {lset, not compiled, second index out of range} {
554     set a {{b c} {d e} {f g}}
555     list [catch {eval [list $lset a 2 2 h]} msg] $msg
556 } {1 {list index out of range}}
558 test lset-8.9 {lset, not compiled, second index out of range} {
559     set a {{b c} {d e} {f g}}
560     list [catch {eval [list $lset a 2 end--1 h]} msg] $msg
561 } {1 {list index out of range}}
563 test lset-8.11 {lset, not compiled, second index out of range} {
564     set a {{b c} {d e} {f g}}
565     list [catch {eval [list $lset a 2 end-2 h]} msg] $msg
566 } {1 {list index out of range}}
568 test lset-9.1 {lset, not compiled, entire variable} {
569     set a x
570     list [eval [list $lset a y]] $a
571 } {y y}
573 test lset-10.1 {lset, not compiled, shared data} {
574     set row {p q}
575     set a [list $row $row]
576     list [eval [list $lset a 0 0 x]] $a
577 } {{{x q} {p q}} {{x q} {p q}}}
579 test lset-11.1 {lset, not compiled, 2-d basics} {
580     set a {{b c} {d e}}
581     list [eval [list $lset a 0 0 f]] $a
582 } {{{f c} {d e}} {{f c} {d e}}}
584 test lset-11.3 {lset, not compiled, 2-d basics} {
585     set a {{b c} {d e}}
586     list [eval [list $lset a 0 1 f]] $a
587 } {{{b f} {d e}} {{b f} {d e}}}
589 test lset-11.5 {lset, not compiled, 2-d basics} {
590     set a {{b c} {d e}}
591     list [eval [list $lset a 1 0 f]] $a
592 } {{{b c} {f e}} {{b c} {f e}}}
594 test lset-11.7 {lset, not compiled, 2-d basics} {
595     set a {{b c} {d e}}
596     list [eval [list $lset a 1 1 f]] $a
597 } {{{b c} {d f}} {{b c} {d f}}}
599 test lset-12.0 {lset, not compiled, typical sharing pattern} {
600     set zero 0
601     set row [list $zero $zero $zero $zero]
602     set ident [list $row $row $row $row]
603     for { set i 0 } { $i < 4 } { incr i } {
604         eval [list $lset ident $i $i 1]
605     }
606     set ident
607 } {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}}
609 test lset-13.0 {lset, not compiled, shimmering hell} {
610     set a 0
611     list [eval [list $lset a $a $a $a $a {gag me}]] $a
612 } {{{{{{gag me}}}}} {{{{{gag me}}}}}}
614 test lset-13.1 {lset, not compiled, shimmering hell} {
615     set a [list 0]
616     list [eval [list $lset a $a $a $a $a {gag me}]] $a
617 } {{{{{{gag me}}}}} {{{{{gag me}}}}}}
619 test lset-14.1 {lset, not compiled, list args, is string rep preserved?} {
620     set a { { 1 2 } { 3 4 } }
621     catch { eval [list $lset a {1 5} 5] }
622     list $a [lindex $a 1]
623 } "{ { 1 2 } { 3 4 } } { 3 4 }"
625 catch {unset noRead}
626 catch {unset noWrite}
627 catch {rename failTrace {}}
628 catch {unset ::x}
629 catch {unset ::y}
631 ################################################################################
632 # IF
633 ################################################################################
635 test if-1.1 {bad syntax: lacking all} {
636         catch {if}
637 } 1
638 test if-1.2 {bad syntax: lacking then-clause} {
639         catch {if 1==1}
640 } 1
641 test if-1.3 {bad syntax: lacking then-clause 2} {
642         catch {if 1==1 then}
643 } 1
644 test if-1.4 {bad syntax: lacking else-clause after keyword 'else'} {
645         catch {if 1==0 then {list 1} else}
646 } 1
647 test if-1.5 {bad syntax: lacking expr after 'elseif'} {
648         catch {if 1==0 then {list 1} elseif}
649 } 1
650 test if-1.6 {bad syntax: lacking then-clause after 'elseif'} {
651         catch {if 1==0 then {list 1} elseif 1==1}
652 } 1
653 test if-1.7 {bad syntax: lacking else-clause after 'elseif' after keyword 'else'} {
654         catch {if 1==0 then {list 1} elseif 1==0 {list 2} else}
655 } 1
656 test if-1.8 {bad syntax: extra arg after implicit else-clause} {
657         catch {if 1==0 {list 1} elseif 1==0 then {list 2} {list 3} else}
658 } 1
659 test if-1.9 {bad syntax: elsif-clause after else-clause} {
660         catch {if 1==0 {list 1} else {list 2} elseif 1==1 {list 3}}
661 } 1
662 test if-2.1 {taking proper branch} {
663     set a {}
664     if 0 {set a 1} else {set a 2}
665     set a
666 } 2
667 test if-2.2 {taking proper branch} {
668     set a {}
669     if 1 {set a 1} else {set a 2}
670     set a
671 } 1
672 test if-2.3 {taking proper branch} {
673     set a {}
674     if 1<2 {set a 1}
675     set a
676 } 1
677 test if-2.4 {taking proper branch} {
678     set a {}
679     if 1>2 {set a 1}
680     set a
681 } {}
682 test if-2.5 {taking proper branch} {
683     set a {}
684     if 0 {set a 1} else {}
685     set a
686 } {}
687 test if-2.6 {taking proper branch} {
688     set a {}
689     if 0 {set a 1} elseif 1 {set a 2} elseif 1 {set a 3} else {set a 4}
690     set a
691 } 2
692 test if-2.7 {taking proper branch} {
693     set a {}
694     if 0 {set a 1} elseif 0 {set a 2} elseif 1 {set a 3} else {set a 4}
695     set a
696 } 3
697 test if-2.8 {taking proper branch} {
698     set a {}
699     if 0 {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} else {set a 4}
700     set a
701 } 4
702 test if-2.9 {taking proper branch, multiline test expr} {
703     set a {}
704     if {1 != \
705              3} {set a 3} else {set a 4}
706     set a
707 } 3
708 test if-3.1 {optional then-else args} {
709     set a 44
710     if 0 then {set a 1} elseif 0 then {set a 3} else {set a 2}
711     set a
712 } 2
713 test if-3.2 {optional then-else args} {
714     set a 44
715     if 1 then {set a 1} else {set a 2}
716     set a
717 } 1
718 test if-3.3 {optional then-else args} {
719     set a 44
720     if 0 {set a 1} else {set a 2}
721     set a
722 } 2
723 test if-3.4 {optional then-else args} {
724     set a 44
725     if 1 {set a 1} else {set a 2}
726     set a
727 } 1
728 test if-3.5 {optional then-else args} {
729     set a 44
730     if 0 then {set a 1} {set a 2}
731     set a
732 } 2
733 test if-3.6 {optional then-else args} {
734     set a 44
735     if 1 then {set a 1} {set a 2}
736     set a
737 } 1
738 test if-3.7 {optional then-else args} {
739     set a 44
740     if 0 then {set a 1} else {set a 2}
741     set a
742 } 2
743 test if-3.8 {optional then-else args} {
744     set a 44
745     if 0 then {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} {set a 4}
746     set a
747 } 4
748 test if-4.1 {return value} {
749     if 1 then {set a 22; concat abc}
750 } abc
751 test if-4.2 {return value} {
752     if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
753 } def
754 test if-4.3 {return value} {
755     if 0 then {set a 22; concat abc} else {concat def}
756 } def
757 test if-4.4 {return value} {
758     if 0 then {set a 22; concat abc}
759 } {}
760 test if-4.5 {return value} {
761     if 0 then {set a 22; concat abc} elseif 0 {concat def}
762 } {}
763 test if-5.1 {error conditions} {
764     list [catch {if {[error "error in condition"]} foo} msg] $msg
765 } {1 {error in condition}}
766 test if-5.2 {error conditions} {
767     list [catch {if 2 the} msg] $msg
768 } {1 {invalid command name "the"}}
769 test if-5.3 {error conditions} {
770     list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
771 } {1 {error in then clause}}
772 test if-5.4 {error conditions} {
773     list [catch {if 0 then foo elsei} msg] $msg
774 } {1 {invalid command name "elsei"}}
775 test if-5.5 {error conditions} {
776     list [catch {if 0 then foo elseif 0 bar els} msg] $msg
777 } {1 {invalid command name "els"}}
778 test if-5.6 {error conditions} {
779     list [catch {if 0 then foo elseif 0 bar else {[error "error in else clause"]}} msg] $msg
780 } {1 {error in else clause}}
782 ################################################################################
783 # APPEND
784 ################################################################################
786 catch {unset x}
788 test append-1.1 {append command} {
789     catch {unset x}
790     list [append x 1 2 abc "long string"] $x
791 } {{12abclong string} {12abclong string}}
792 test append-1.2 {append command} {
793     set x ""
794     list [append x first] [append x second] [append x third] $x
795 } {first firstsecond firstsecondthird firstsecondthird}
796 test append-1.3 {append command} {
797     set x "abcd"
798     append x
799 } abcd
801 test append-2.1 {long appends} {
802     set x ""
803     for {set i 0} {$i < 1000} {set i [expr $i+1]} {
804         append x "foobar "
805     }
806     set y "foobar"
807     set y "$y $y $y $y $y $y $y $y $y $y"
808     set y "$y $y $y $y $y $y $y $y $y $y"
809     set y "$y $y $y $y $y $y $y $y $y $y "
810     expr {$x eq $y}
811 } 1
813 test append-3.1 {append errors} {
814     list [catch {append} msg] $msg
815 } {1 {wrong # args: should be "append varName ?value ...?"}}
816 test append-3.2 {append errors} {
817     set x 1
818     list [catch {append x(0) 44} msg] $msg
819 } {1 {can't set "x(0)": variable isn't array}}
820 test append-3.3 {append errors} {
821     catch {unset x}
822     list [catch {append x} msg] $msg
823 } {1 {can't read "x": no such variable}}
825 test append-4.1 {lappend command} {
826     catch {unset x}
827     list [lappend x 1 2 abc "long string"] $x
828 } {{1 2 abc {long string}} {1 2 abc {long string}}}
829 test append-4.2 {lappend command} {
830     set x ""
831     list [lappend x first] [lappend x second] [lappend x third] $x
832 } {first {first second} {first second third} {first second third}}
833 test append-4.3 {lappend command} {
834     proc foo {} {
835         global x
836         set x old
837         unset x
838         lappend x new
839     }
840     set result [foo]
841     rename foo {}
842     set result
843 } {new}
844 test append-4.4 {lappend command} {
845     set x {}
846     lappend x \{\  abc
847 } {\{\  abc}
848 test append-4.5 {lappend command} {
849     set x {}
850     lappend x \{ abc
851 } {\{ abc}
852 test append-4.6 {lappend command} {
853     set x {1 2 3}
854     lappend x
855 } {1 2 3}
856 test append-4.7 {lappend command} {
857     set x "a\{"
858     lappend x abc
859 } "a\\\{ abc"
860 test append-4.8 {lappend command} {
861     set x "\\\{"
862     lappend x abc
863 } "\\{ abc"
864 #test append-4.9 {lappend command} {
865 #    set x " \{"
866 #    list [catch {lappend x abc} msg] $msg
867 #} {1 {unmatched open brace in list}}
868 #test append-4.10 {lappend command} {
869 #    set x "    \{"
870 #    list [catch {lappend x abc} msg] $msg
871 #} {1 {unmatched open brace in list}}
872 #test append-4.11 {lappend command} {
873 #    set x "\{\{\{"
874 #    list [catch {lappend x abc} msg] $msg
875 #} {1 {unmatched open brace in list}}
876 #test append-4.12 {lappend command} {
877 #    set x "x \{\{\{"
878 #    list [catch {lappend x abc} msg] $msg
879 #} {1 {unmatched open brace in list}}
880 test append-4.13 {lappend command} {
881     set x "x\{\{\{"
882     lappend x abc
883 } "x\\\{\\\{\\\{ abc"
884 test append-4.14 {lappend command} {
885     set x " "
886     lappend x abc
887 } "abc"
888 test append-4.15 {lappend command} {
889     set x "\\ "
890     lappend x abc
891 } "{ } abc"
892 test append-4.16 {lappend command} {
893     set x "x "
894     lappend x abc
895 } "x abc"
896 test append-4.17 {lappend command} {
897     catch {unset x}
898     lappend x
899 } {}
900 test append-4.18 {lappend command} {
901     catch {unset x}
902     lappend x {}
903 } {{}}
904 test append-4.19 {lappend command} {
905     catch {unset x}
906     lappend x(0)
907 } {}
908 test append-4.20 {lappend command} {
909     catch {unset x}
910     lappend x(0) abc
911 } {abc}
913 proc check {var size} {
914     set l [llength $var]
915     if {$l != $size} {
916         return "length mismatch: should have been $size, was $l"
917     }
918     for {set i 0} {$i < $size} {set i [expr $i+1]} {
919         set j [lindex $var $i]
920         if {$j ne "item $i"} {
921             return "element $i should have been \"item $i\", was \"$j\""
922         }
923     }
924     return ok
926 test append-5.1 {long lappends} {
927     catch {unset x}
928     set x ""
929     for {set i 0} {$i < 300} {set i [expr $i+1]} {
930         lappend x "item $i"
931     }
932     check $x 300
933 } ok
935 test append-6.1 {lappend errors} {
936     list [catch {lappend} msg] $msg
937 } {1 {wrong # args: should be "lappend varName ?value value ...?"}}
938 test append-6.2 {lappend errors} {
939     set x 1
940     list [catch {lappend x(0) 44} msg] $msg
941 } {1 {can't set "x(0)": variable isn't array}}
943 ################################################################################
944 # UPLEVEL
945 ################################################################################
947 proc a {x y} {
948     newset z [expr $x+$y]
949     return $z
951 proc newset {name value} {
952     uplevel set $name $value
953     uplevel 1 {uplevel 1 {set xyz 22}}
956 test uplevel-1.1 {simple operation} {
957     set xyz 0
958     a 22 33
959 } 55
960 test uplevel-1.2 {command is another uplevel command} {
961     set xyz 0
962     a 22 33
963     set xyz
964 } 22
966 proc a1 {} {
967     b1
968     global a a1
969     set a $x
970     set a1 $y
972 proc b1 {} {
973     c1
974     global b b1
975     set b $x
976     set b1 $y
978 proc c1 {} {
979     uplevel 1 set x 111
980     uplevel #2 set y 222
981     uplevel 2 set x 333
982     uplevel #1 set y 444
983     uplevel 3 set x 555
984     uplevel #0 set y 666
987 test uplevel-2.1 {relative and absolute uplevel} {set a} 333
988 test uplevel-2.2 {relative and absolute uplevel} {set a1} 444
989 test uplevel-2.3 {relative and absolute uplevel} {set b} 111
990 test uplevel-2.4 {relative and absolute uplevel} {set b1} 222
991 test uplevel-2.5 {relative and absolute uplevel} {set x} 555
992 test uplevel-2.6 {relative and absolute uplevel} {set y} 666
994 test uplevel-3.1 {uplevel to same level} {
995     set x 33
996     uplevel #0 set x 44
997     set x
998 } 44
999 test uplevel-3.2 {uplevel to same level} {
1000     set x 33
1001     uplevel 0 set x
1002 } 33
1003 test uplevel-3.3 {uplevel to same level} {
1004     set y xxx
1005     proc a1 {} {set y 55; uplevel 0 set y 66; return $y}
1006     a1
1007 } 66
1008 test uplevel-3.4 {uplevel to same level} {
1009     set y zzz
1010     proc a1 {} {set y 55; uplevel #1 set y}
1011     a1
1012 } 55
1014 test uplevel-4.1 {error: non-existent level} {
1015     list [catch c1 msg] $msg
1016 } {1 {bad level "#2"}}
1017 test uplevel-4.2 {error: non-existent level} {
1018     proc c2 {} {uplevel 3 {set a b}}
1019     list [catch c2 msg] $msg
1020 } {1 {bad level "3"}}
1021 test uplevel-4.3 {error: not enough args} {
1022     list [catch uplevel msg] $msg
1023 } {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
1024 test uplevel-4.4 {error: not enough args} {
1025     proc upBug {} {uplevel 1}
1026     list [catch upBug msg] $msg
1027 } {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
1029 proc a2 {} {
1030     uplevel a3
1032 proc a3 {} {
1033     global x y
1034     set x [info level]
1035     set y [info level 1]
1038 test uplevel-5.1 {info level} {set x} 1
1039 test uplevel-5.2 {info level} {set y} a3
1041 ################################################################################
1042 # UNKNOWN
1043 ################################################################################
1045 catch {unset x}
1046 catch {rename unknown unknown.old}
1048 test unknown-1.1 {non-existent "unknown" command} {
1049     list [catch {_non-existent_ foo bar} msg] $msg
1050 } {1 {invalid command name "_non-existent_"}}
1052 proc unknown {args} {
1053     global x
1054     set x $args
1057 test unknown-2.1 {calling "unknown" command} {
1058     foobar x y z
1059     set x
1060 } {foobar x y z}
1061 test unknown-2.2 {calling "unknown" command with lots of args} {
1062     foobar 1 2 3 4 5 6 7
1063     set x
1064 } {foobar 1 2 3 4 5 6 7}
1065 test unknown-2.3 {calling "unknown" command with lots of args} {
1066     foobar 1 2 3 4 5 6 7 8
1067     set x
1068 } {foobar 1 2 3 4 5 6 7 8}
1069 test unknown-2.4 {calling "unknown" command with lots of args} {
1070     foobar 1 2 3 4 5 6 7 8 9
1071     set x
1072 } {foobar 1 2 3 4 5 6 7 8 9}
1074 test unknown-3.1 {argument quoting in calls to "unknown"} {
1075     foobar \{ \} a\{b \; "\\" \$a a\[b \]
1076     set x
1077 } "foobar \\{ \\} a\\{b {;} \\\\ {\$a} {a\[b} \\]"
1079 proc unknown args {
1080     error "unknown failed"
1083 test unknown-4.1 {errors in "unknown" procedure} {
1084     list [catch {non-existent a b} msg] $msg
1085 } {1 {unknown failed}}
1087 rename unknown {}
1089 ################################################################################
1090 # INCR
1091 ################################################################################
1093 catch {unset x}
1094 catch {unset i}
1096 test incr-1.1 {TclCompileIncrCmd: missing variable name} {
1097     list [catch {incr} msg] $msg
1098 } {1 {wrong # args: should be "incr varName ?increment?"}}
1099 test incr-1.2 {TclCompileIncrCmd: simple variable name} {
1100     set i 10
1101     list [incr i] $i
1102 } {11 11}
1103 #test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
1104 #    set i 10
1105 #    catch {incr "i"xxx} msg
1106 #    set msg
1107 #} {extra characters after close-quote}
1108 test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
1109     set i 17
1110     list [incr "i"] $i
1111 } {18 18}
1112 test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} {
1113     catch {unset {a simple var}}
1114     set {a simple var} 27
1115     list [incr {a simple var}] ${a simple var}
1116 } {28 28}
1117 test incr-1.6 {TclCompileIncrCmd: simple array variable name} {
1118     catch {unset a}
1119     set a(foo) 37
1120     list [incr a(foo)] $a(foo)
1121 } {38 38}
1122 test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
1123     set x "i"
1124     set i 77
1125     list [incr $x 2] $i
1126 } {79 79}
1127 test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
1128     set x "i"
1129     set i 77
1130     list [incr [set x] +2] $i
1131 } {79 79}
1133 test incr-1.9 {TclCompileIncrCmd: increment given} {
1134     set i 10
1135     list [incr i +07] $i
1136 } {17 17}
1137 test incr-1.10 {TclCompileIncrCmd: no increment given} {
1138     set i 10
1139     list [incr i] $i
1140 } {11 11}
1142 test incr-1.11 {TclCompileIncrCmd: simple global name} {
1143     proc p {} {
1144         global i
1145         set i 54
1146         incr i
1147     }
1148     p
1149 } {55}
1150 test incr-1.12 {TclCompileIncrCmd: simple local name} {
1151     proc p {} {
1152         set foo 100
1153         incr foo
1154     }
1155     p
1156 } {101}
1157 test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} {
1158     proc p {} {
1159         incr bar
1160     }
1161     catch {p} msg
1162     set msg
1163 } {1}
1164 test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
1165     proc 260locals {} {
1166         # create 260 locals
1167         set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
1168         set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
1169         set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
1170         set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
1171         set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
1172         set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
1173         set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
1174         set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
1175         set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
1176         set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
1177         set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
1178         set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
1179         set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
1180         set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
1181         set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
1182         set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
1183         set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
1184         set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
1185         set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
1186         set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
1187         set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
1188         set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
1189         set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
1190         set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
1191         set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
1192         set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
1193         set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
1194         set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
1195         set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
1196         set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
1197         set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
1198         set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
1199         set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
1200         set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
1201         set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
1202         set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
1203         set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
1204         set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
1205         set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
1206         set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
1207         set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
1208         set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
1209         set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
1210         set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
1211         set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
1212         set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
1213         set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
1214         set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
1215         set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
1216         set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
1217         set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
1218         set z5 0; set z6 0; set z7 0; set z8 0; set z9 0
1219         # now increment the last one (local var index > 255)
1220         incr z9
1221     }
1222     260locals
1223 } {1}
1224 test incr-1.15 {TclCompileIncrCmd: variable is array} {
1225     catch {unset a}
1226     set a(foo) 27
1227     set x [incr a(foo) 11]
1228     catch {unset a}
1229     set x
1230 } 38
1231 test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} {
1232     catch {unset a}
1233     set i 5
1234     set a(foo5) 27
1235     set x [incr a(foo$i) 11]
1236     catch {unset a}
1237     set x
1238 } 38
1240 test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
1241     set i 5
1242     incr i 123
1243 } 128
1244 test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
1245     set i 5
1246     incr i -100
1247 } -95
1248 #test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} {
1249 #    set i 5
1250 #    catch {incr i [set]} msg
1251 #    set errorInfo
1252 #} {wrong # args: should be "set varName ?newValue?"
1253 #    while compiling
1254 #"set"
1255 #    while compiling
1256 #"incr i [set]"}
1257 test incr-1.20 {TclCompileIncrCmd: increment given, in quotes} {
1258     set i 25
1259     incr i "-100"
1260 } -75
1261 test incr-1.21 {TclCompileIncrCmd: increment given, in braces} {
1262     set i 24
1263     incr i {126}
1264 } 150
1265 test incr-1.22 {TclCompileIncrCmd: increment given, large int} {
1266     set i 5
1267     incr i 200000
1268 } 200005
1269 test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
1270     set i 25
1271     incr i 000012345     ;# a decimal literal
1272 } 12370
1273 test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
1274     set i 25
1275     catch {incr i 1a} msg
1276     set msg
1277 } {expected integer but got "1a"}
1279 test incr-1.25 {TclCompileIncrCmd: too many arguments} {
1280     set i 10
1281     catch {incr i 10 20} msg
1282     set msg
1283 } {wrong # args: should be "incr varName ?increment?"}
1286 test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
1287     set x "  -  "
1288     list [catch {incr x 1} msg] $msg
1289 } {1 {expected integer but got "  -  "}}
1291 test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} {
1292     catch {unset array}
1293     set array(\$foo) 4
1294     incr {array($foo)}
1295 } 5
1296     
1297 # Check "incr" and computed command names.
1299 test incr-2.0 {incr and computed command names} {
1300     set i 5
1301     set z incr
1302     $z i -1
1303     set i
1304 } 4
1305 catch {unset x}
1306 catch {unset i}
1308 test incr-2.1 {incr command (not compiled): missing variable name} {
1309     set z incr
1310     list [catch {$z} msg] $msg
1311 } {1 {wrong # args: should be "incr varName ?increment?"}}
1312 test incr-2.2 {incr command (not compiled): simple variable name} {
1313     set z incr
1314     set i 10
1315     list [$z i] $i
1316 } {11 11}
1317 test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
1318     set z incr
1319     set i 17
1320     list [$z "i"] $i
1321 } {18 18}
1322 test incr-2.5 {incr command (not compiled): simple variable name in braces} {
1323     set z incr
1324     catch {unset {a simple var}}
1325     set {a simple var} 27
1326     list [$z {a simple var}] ${a simple var}
1327 } {28 28}
1328 test incr-2.6 {incr command (not compiled): simple array variable name} {
1329     set z incr
1330     catch {unset a}
1331     set a(foo) 37
1332     list [$z a(foo)] $a(foo)
1333 } {38 38}
1334 test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
1335     set z incr
1336     set x "i"
1337     set i 77
1338     list [$z $x 2] $i
1339 } {79 79}
1340 test incr-2.8 {incr command (not compiled): non-simple (computed) variable name} {
1341     set z incr
1342     set x "i"
1343     set i 77
1344     list [$z [set x] +2] $i
1345 } {79 79}
1347 test incr-2.9 {incr command (not compiled): increment given} {
1348     set z incr
1349     set i 10
1350     list [$z i +07] $i
1351 } {17 17}
1352 test incr-2.10 {incr command (not compiled): no increment given} {
1353     set z incr
1354     set i 10
1355     list [$z i] $i
1356 } {11 11}
1358 test incr-2.11 {incr command (not compiled): simple global name} {
1359     proc p {} {
1360         set z incr
1361         global i
1362         set i 54
1363         $z i
1364     }
1365     p
1366 } {55}
1367 test incr-2.12 {incr command (not compiled): simple local name} {
1368     proc p {} {
1369         set z incr
1370         set foo 100
1371         $z foo
1372     }
1373     p
1374 } {101}
1375 test incr-2.13 {incr command (not compiled): simple but new (unknown) local name} {
1376     proc p {} {
1377         set z incr
1378         $z bar
1379     }
1380     catch {p} msg
1381     set msg
1382 } {1}
1383 test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
1384    proc 260locals {} {
1385         set z incr
1386         # create 260 locals
1387         set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
1388         set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
1389         set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
1390         set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
1391         set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
1392         set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
1393         set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
1394         set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
1395         set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
1396         set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
1397         set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
1398         set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
1399         set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
1400         set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
1401         set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
1402         set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
1403         set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
1404         set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
1405         set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
1406         set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
1407         set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
1408         set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
1409         set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
1410         set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
1411         set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
1412         set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
1413         set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
1414         set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
1415         set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
1416         set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
1417         set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
1418         set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
1419         set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
1420         set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
1421         set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
1422         set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
1423         set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
1424         set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
1425         set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
1426         set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
1427         set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
1428         set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
1429         set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
1430         set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
1431         set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
1432         set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
1433         set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
1434         set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
1435         set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
1436         set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
1437         set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
1438         set z5 0; set z6 0; set z7 0; set z8 0; set z9 0
1439         # now increment the last one (local var index > 255)
1440         $z z9
1441     }
1442     260locals
1443 } {1}
1444 test incr-2.15 {incr command (not compiled): variable is array} {
1445     set z incr
1446     catch {unset a}
1447     set a(foo) 27
1448     set x [$z a(foo) 11]
1449     catch {unset a}
1450     set x
1451 } 38
1452 test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} {
1453     set z incr
1454     catch {unset a}
1455     set i 5
1456     set a(foo5) 27
1457     set x [$z a(foo$i) 11]
1458     catch {unset a}
1459     set x
1460 } 38
1462 test incr-2.17 {incr command (not compiled): increment given, simple int} {
1463     set z incr
1464     set i 5
1465     $z i 123
1466 } 128
1467 test incr-2.18 {incr command (not compiled): increment given, simple int} {
1468     set z incr
1469     set i 5
1470     $z i -100
1471 } -95
1472 test incr-2.20 {incr command (not compiled): increment given, in quotes} {
1473     set z incr
1474     set i 25
1475     $z i "-100"
1476 } -75
1477 test incr-2.21 {incr command (not compiled): increment given, in braces} {
1478     set z incr
1479     set i 24
1480     $z i {126}
1481 } 150
1482 test incr-2.22 {incr command (not compiled): increment given, large int} {
1483     set z incr
1484     set i 5
1485     $z i 200000
1486 } 200005
1487 test incr-2.23 {incr command (not compiled): increment given, formatted int != int} {
1488     set z incr
1489     set i 25
1490     $z i 000012345     ;# an octal literal
1491 } 12370
1492 test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
1493     set z incr
1494     set i 25
1495     catch {$z i 1a} msg
1496     set msg
1497 } {expected integer but got "1a"}
1499 test incr-2.25 {incr command (not compiled): too many arguments} {
1500     set z incr
1501     set i 10
1502     catch {$z i 10 20} msg
1503     set msg
1504 } {wrong # args: should be "incr varName ?increment?"}
1506 test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
1507     set z incr
1508     set x "  -  "
1509     list [catch {$z x 1} msg] $msg
1510 } {1 {expected integer but got "  -  "}}
1512 ################################################################################
1513 # LLENGTH
1514 ################################################################################
1516 test llength-1.1 {length of list} {
1517     llength {a b c d}
1518 } 4
1519 test llength-1.2 {length of list} {
1520     llength {a b c {a b {c d}} d}
1521 } 5
1522 test llength-1.3 {length of list} {
1523     llength {}
1524 } 0
1526 test llength-2.1 {error conditions} {
1527     list [catch {llength} msg] $msg
1528 } {1 {wrong # args: should be "llength list"}}
1529 test llength-2.2 {error conditions} {
1530     list [catch {llength 123 2} msg] $msg
1531 } {1 {wrong # args: should be "llength list"}}
1533 ################################################################################
1534 # LINDEX
1535 ################################################################################
1537 set lindex lindex
1538 set minus -
1540 # Tests of Tcl_LindexObjCmd, NOT COMPILED
1542 test lindex-1.1 {wrong # args} {
1543     list [catch {eval $lindex} result] $result
1544 } "1 {wrong # args: should be \"lindex list ?index ...?\"}"
1546 # Indices that are lists or convertible to lists
1548 #test lindex-2.1 {empty index list} {
1549 #    set x {}
1550 #    list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1551 #} {{a b c} {a b c}}
1553 test lindex-2.2 {singleton index list} {
1554     set x { 1 }
1555     list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1556 } {b b}
1558 test lindex-2.4 {malformed index list} {
1559     set x \{
1560     list [catch { eval [list $lindex {a b c} $x] } result] $result
1561 } {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
1563 # Indices that are integers or convertible to integers
1565 test lindex-3.1 {integer -1} {
1566     set x ${minus}1
1567     list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1568 } {{} {}}
1570 test lindex-3.2 {integer 0} {
1571     set x [string range 00 0 0]
1572     list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1573 } {a a}
1575 test lindex-3.3 {integer 2} {
1576     set x [string range 22 0 0]
1577     list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1578 } {c c}
1580 test lindex-3.4 {integer 3} {
1581     set x [string range 33 0 0]
1582     list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1583 } {{} {}}
1585 test lindex-3.7 {indexes don't shimmer wide ints} {
1586     set x [expr {(1<<31) - 2}]
1587     list $x [lindex {1 2 3} $x] [incr x] [incr x]
1588 } {2147483646 {} 2147483647 2147483648}
1590 # Indices relative to end
1592 test lindex-4.1 {index = end} {
1593     set x end
1594     list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1595 } {c c}
1597 test lindex-4.2 {index = end--1} {
1598     set x end--1
1599     list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1600 } {{} {}}
1602 test lindex-4.3 {index = end-0} {
1603     set x end-0
1604     list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1605 } {c c}
1607 test lindex-4.4 {index = end-2} {
1608     set x end-2
1609     list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1610 } {a a}
1612 test lindex-4.5 {index = end-3} {
1613     set x end-3
1614     list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1615 } {{} {}}
1617 test lindex-4.8 {bad integer, not octal} {
1618     set x end-0a2
1619     list [catch { eval [list $lindex {a b c} $x] } result] $result
1620 } {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
1622 #test lindex-4.9 {incomplete end} {
1623 #    set x en
1624 #    list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1625 #} {c c}
1627 test lindex-4.10 {incomplete end-} {
1628     set x end-
1629     list [catch { eval [list $lindex {a b c} $x] } result] $result
1630 } {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}}
1632 test lindex-5.1 {bad second index} {
1633     list [catch { eval [list $lindex {a b c} 0 0a2] } result] $result
1634 } {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
1636 test lindex-5.2 {good second index} {
1637     eval [list $lindex {{a b c} {d e f} {g h i}} 1 2]
1638 } f
1640 test lindex-5.3 {three indices} {
1641     eval [list $lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1]
1642 } f
1644 test lindex-7.1 {quoted elements} {
1645     eval [list $lindex {a "b c" d} 1]
1646 } {b c}
1647 test lindex-7.2 {quoted elements} {
1648     eval [list $lindex {"{}" b c} 0]
1649 } {{}}
1650 test lindex-7.3 {quoted elements} {
1651     eval [list $lindex {ab "c d \" x" y} 1]
1652 } {c d " x}
1653 test lindex-7.4 {quoted elements} {
1654     lindex {a b {c d "e} {f g"}} 2
1655 } {c d "e}
1657 test lindex-8.1 {data reuse} {
1658     set x 0
1659     eval [list $lindex $x $x]
1660 } {0}
1662 test lindex-8.2 {data reuse} {
1663     set a 0
1664     eval [list $lindex $a $a $a]
1665 } 0
1666 test lindex-8.3 {data reuse} {
1667     set a 1
1668     eval [list $lindex $a $a $a]
1669 } {}
1671 #----------------------------------------------------------------------
1673 test lindex-10.2 {singleton index list} {
1674     set x { 1 }
1675     catch {
1676         list [lindex {a b c} $x] [lindex {a b c} $x]
1677     } result
1678     set result
1679 } {b b}
1681 test lindex-10.4 {malformed index list} {
1682     set x \{
1683     list [catch { lindex {a b c} $x } result] $result
1684 } {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
1686 # Indices that are integers or convertible to integers
1688 test lindex-11.1 {integer -1} {
1689     set x ${minus}1
1690     catch {
1691         list [lindex {a b c} $x] [lindex {a b c} $x]
1692     } result
1693     set result
1694 } {{} {}}
1696 test lindex-11.2 {integer 0} {
1697     set x [string range 00 0 0]
1698     catch {
1699         list [lindex {a b c} $x] [lindex {a b c} $x]
1700     } result
1701     set result
1702 } {a a}
1704 test lindex-11.3 {integer 2} {
1705     set x [string range 22 0 0]
1706     catch {
1707         list [lindex {a b c} $x] [lindex {a b c} $x]
1708     } result
1709     set result
1710 } {c c}
1712 test lindex-11.4 {integer 3} {
1713     set x [string range 33 0 0]
1714     catch {
1715         list [lindex {a b c} $x] [lindex {a b c} $x]
1716     } result
1717     set result
1718 } {{} {}}
1720 # Indices relative to end
1721 test lindex-12.1 {index = end} {
1722     set x end
1723     catch {
1724         list [lindex {a b c} $x] [lindex {a b c} $x]
1725     } result
1726     set result
1727 } {c c}
1729 test lindex-12.2 {index = end--1} {
1730     set x end--1
1731     catch {
1732         list [lindex {a b c} $x] [lindex {a b c} $x]
1733     } result
1734     set result
1735 } {{} {}}
1737 test lindex-12.3 {index = end-0} {
1738     set x end-0
1739     catch {
1740         list [lindex {a b c} $x] [lindex {a b c} $x]
1741     } result
1742     set result
1743 } {c c}
1745 test lindex-12.4 {index = end-2} {
1746     set x end-2
1747     catch {
1748         list [lindex {a b c} $x] [lindex {a b c} $x]
1749     } result
1750     set result
1751 } {a a}
1753 test lindex-12.5 {index = end-3} {
1754     set x end-3
1755     catch {
1756         list [lindex {a b c} $x] [lindex {a b c} $x]
1757     } result
1758     set result
1759 } {{} {}}
1761 test lindex-12.8 {bad integer, not octal} {
1762     set x end-0a2
1763     list [catch { lindex {a b c} $x } result] $result
1764 } {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
1766 test lindex-12.10 {incomplete end-} {
1767     set x end-
1768     list [catch { lindex {a b c} $x } result] $result
1769 } {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}}
1771 test lindex-13.1 {bad second index} {
1772     list [catch { lindex {a b c} 0 0a2 } result] $result
1773 } {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
1775 test lindex-13.2 {good second index} {
1776     catch {
1777         lindex {{a b c} {d e f} {g h i}} 1 2
1778     } result
1779     set result
1780 } f
1782 test lindex-13.3 {three indices} {
1783     catch {
1784         lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1
1785     } result
1786     set result
1787 } f
1789 test lindex-15.1 {quoted elements} {
1790     catch {
1791         lindex {a "b c" d} 1
1792     } result
1793     set result
1794 } {b c}
1795 test lindex-15.2 {quoted elements} {
1796     catch {
1797         lindex {"{}" b c} 0
1798     } result
1799     set result
1800 } {{}}
1801 test lindex-15.3 {quoted elements} {
1802     catch {
1803         lindex {ab "c d \" x" y} 1
1804     } result
1805     set result
1806 } {c d " x}
1807 test lindex-15.4 {quoted elements} {
1808     catch {
1809         lindex {a b {c d "e} {f g"}} 2
1810     } result
1811     set result
1812 } {c d "e}
1814 test lindex-16.1 {data reuse} {
1815     set x 0
1816     catch {
1817         lindex $x $x
1818     } result
1819     set result
1820 } {0}
1822 test lindex-16.2 {data reuse} {
1823     set a 0
1824     catch {
1825         lindex $a $a $a
1826     } result
1827     set result
1828 } 0
1829 test lindex-16.3 {data reuse} {
1830     set a 1
1831     catch {
1832         lindex $a $a $a
1833     } result
1834     set result
1835 } {}
1837 test lindex-17.1 {no index} {
1838     lindex {a b c}
1839 } {a b c}
1841 catch { unset lindex}
1842 catch { unset minus }
1844 ################################################################################
1845 # LINDEX
1846 ################################################################################
1848 catch {unset a}
1849 catch {unset x}
1851 # Basic "foreach" operation.
1853 test foreach-1.1 {basic foreach tests} {
1854         set a {}
1855         foreach i {a b c d} {
1856                 set a [concat $a $i]
1857         }
1858         set a
1859 } {a b c d}
1860 test foreach-1.2 {basic foreach tests} {
1861   set a {}
1862   foreach i {a b {{c d} e} {123 {{x}}}} {
1863                 set a [concat $a $i]
1864         }
1865   set a
1866 } {a b {c d} e 123 {{x}}}
1867 test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1
1868 test foreach-1.4 {basic foreach tests} {catch {foreach i} msg} 1
1869 test foreach-1.5 {basic foreach tests} {catch {foreach i j} msg} 1
1870 test foreach-1.6 {basic foreach tests} {catch {foreach i j k l} msg} 1
1871 test foreach-1.7 {basic foreach tests} {
1872   set a {}
1873   foreach i {} {
1874                 set a [concat $a $i]
1875         }
1876   set a
1877 } {}
1878 catch {unset a}
1879 test foreach-2.1 {foreach errors} {
1880     list [catch {foreach {} {} {}} msg] $msg
1881 } {1 {foreach varlist is empty}}
1882 catch {unset a}
1884 test foreach-3.1 {parallel foreach tests} {
1885   set x {}
1886   foreach {a b} {1 2 3 4} {
1887                 append x $b $a
1888         }
1889   set x
1890 } {2143}
1891 test foreach-3.2 {parallel foreach tests} {
1892   set x {}
1893   foreach {a b} {1 2 3 4 5} {
1894                 append x $b $a
1895   }
1896         set x
1897 } {21435}
1898 test foreach-3.3 {parallel foreach tests} {
1899   set x {}
1900   foreach a {1 2 3} b {4 5 6} {
1901                 append x $b $a
1902         }
1903   set x
1904 } {415263}
1905 test foreach-3.4 {parallel foreach tests} {
1906   set x {}
1907   foreach a {1 2 3} b {4 5 6 7 8} {
1908                 append x $b $a
1909         }
1910   set x
1911 } {41526378}
1912 test foreach-3.5 {parallel foreach tests} {
1913   set x {}
1914   foreach {a b} {a b A B aa bb} c {c C cc CC} {
1915                 append x $a $b $c
1916         }
1917   set x
1918 } {abcABCaabbccCC}
1919 test foreach-3.6 {parallel foreach tests} {
1920   set x {}
1921   foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
1922                 append x $a $b $c $d $e
1923   }
1924         set x
1925 } {111112222233333}
1926 test foreach-3.7 {parallel foreach tests} {
1927   set x {}
1928   foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
1929                 append x $a $b $c $d $e
1930   }
1931         set x
1932 } {1111 2222334}
1933 test foreach-4.1 {foreach only sets vars if repeating loop} {
1934   proc foo {} {
1935                 set rgb {65535 0 0}
1936                 foreach {r g b} [set rgb] {}
1937                 return "r=$r, g=$g, b=$b"
1938         }
1939         foo
1940 } {r=65535, g=0, b=0}
1941 test foreach-5.1 {foreach supports dict syntactic sugar} {
1942         proc foo {} {
1943     set x {}
1944     foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]}
1945                 list $a $x
1946         }
1947         foo
1948 } {{3 4} {1 2 3 4}}
1950 test foreach-6.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
1951   catch {unset x}
1952   foreach {12.0} {a b c} {
1953     set x 12.0  
1954     set x [expr $x + 1]
1955   }
1956   set x
1957 } 13.0
1959 # Check "continue".
1961 test foreach-7.1 {continue tests} {catch continue} 4
1962 test foreach-7.2 {continue tests} {
1963   set a {}
1964   foreach i {a b c d} {
1965                 if {[string compare $i "b"] == 0} continue
1966                 set a [concat $a $i]
1967         }
1968    set a
1969 } {a c d}
1970 test foreach-7.3 {continue tests} {
1971         set a {}
1972   foreach i {a b c d} {
1973                 if {[string compare $i "b"] != 0} continue
1974                 set a [concat $a $i]
1975         }
1976   set a
1977 } {b}
1978 test foreach-7.4 {continue tests} {catch {continue foo} msg} 1
1979 test foreach-7.5 {continue tests} {
1980         catch {continue foo} msg
1981   set msg
1982 } {wrong # args: should be "continue"}
1984 # Check "break".
1986 test foreach-8.1 {break tests} {catch break} 3
1987 test foreach-8.2 {break tests} {
1988   set a {}
1989         foreach i {a b c d} {
1990                 if {[string compare $i "c"] == 0} break
1991                 set a [concat $a $i]
1992         }
1993   set a
1994 } {a b}
1995 test foreach-8.3 {break tests} {catch {break foo} msg} 1
1996 test foreach-8.4 {break tests} {
1997   catch {break foo} msg
1998   set msg
1999 } {wrong # args: should be "break"}
2001 # Test for incorrect "double evaluation" semantics
2003 test foreach-9.1 {delayed substitution of body - knownbugs} {
2004   proc foo {} {
2005     set a 0
2006     foreach a [list 1 2 3] "
2007       set x $a
2008     "
2009     set x
2010   }
2011   foo
2012 } {0}
2014 # cleanup
2015 catch {unset a}
2016 catch {unset x}
2018 ################################################################################
2019 # STRING
2020 ################################################################################
2022 # string last
2023 test string-7.1 {string last, too few args} {
2024     list [catch {string last a} msg] $msg
2025 } {1 {wrong # args: should be "string last subString string ?index?"}}
2026 test string-7.2 {string last, bad args} {
2027     list [catch {string last a b c} msg] $msg
2028 } {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
2029 test string-7.3 {string last, too many args} {
2030     list [catch {string last a b c d} msg] $msg
2031 } {1 {wrong # args: should be "string last subString string ?index?"}}
2032 test string-7.5 {string last} {
2033     string last xx xxxx123xx345x678
2034 } 7
2035 test string-7.13 {string last, start index} {
2036     ## Constrain to last 'a' should work
2037     string last ba badbad end-1
2038 } 3
2039 test string-7.14 {string last, start index} {
2040     ## Constrain to last 'b' should skip last 'ba'
2041     string last ba badbad end-2
2042 } 0
2044 ## string match
2046 test string-11.1 {string match, too few args} {
2047     proc foo {} {string match a}
2048     list [catch {foo} msg] $msg
2049 } {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
2050 test string-11.2 {string match, too many args} {
2051     proc foo {} {string match a b c d}
2052     list [catch {foo} msg] $msg
2053 } {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
2054 test string-11.3 {string match} {
2055     proc foo {} {string match abc abc}
2056     foo
2057 } 1
2058 #test string-11.4 {string match} {
2059 #    proc foo {} {string mat abc abd}
2060 #    foo
2061 #} 0
2062 test string-11.5 {string match} {
2063     proc foo {} {string match ab*c abc}
2064     foo
2065 } 1
2066 test string-11.6 {string match} {
2067     proc foo {} {string match ab**c abc}
2068     foo
2069 } 1
2070 test string-11.7 {string match} {
2071     proc foo {} {string match ab* abcdef}
2072     foo
2073 } 1
2074 test string-11.8 {string match} {
2075     proc foo {} {string match *c abc}
2076     foo
2077 } 1
2078 test string-11.9 {string match} {
2079     proc foo {} {string match *3*6*9 0123456789}
2080     foo
2081 } 1
2082 test string-11.10 {string match} {
2083     proc foo {} {string match *3*6*9 01234567890}
2084     foo
2085 } 0
2086 test string-11.11 {string match} {
2087     proc foo {} {string match a?c abc}
2088     foo
2089 } 1
2090 test string-11.12 {string match} {
2091     proc foo {} {string match a??c abc}
2092     foo
2093 } 0
2094 test string-11.13 {string match} {
2095     proc foo {} {string match ?1??4???8? 0123456789}
2096     foo
2097 } 1
2098 test string-11.14 {string match} {
2099     proc foo {} {string match {[abc]bc} abc}
2100     foo
2101 } 1
2102 test string-11.15 {string match} {
2103     proc foo {} {string match {a[abc]c} abc}
2104     foo
2105 } 1
2106 test string-11.16 {string match} {
2107     proc foo {} {string match {a[xyz]c} abc}
2108     foo
2109 } 0
2110 test string-11.17 {string match} {
2111     proc foo {} {string match {12[2-7]45} 12345}
2112     foo
2113 } 1
2114 test string-11.18 {string match} {
2115     proc foo {} {string match {12[ab2-4cd]45} 12345}
2116     foo
2117 } 1
2118 test string-11.19 {string match} {
2119     proc foo {} {string match {12[ab2-4cd]45} 12b45}
2120     foo
2121 } 1
2122 test string-11.20 {string match} {
2123     proc foo {} {string match {12[ab2-4cd]45} 12d45}
2124     foo
2125 } 1
2126 test string-11.21 {string match} {
2127     proc foo {} {string match {12[ab2-4cd]45} 12145}
2128     foo
2129 } 0
2130 test string-11.22 {string match} {
2131     proc foo {} {string match {12[ab2-4cd]45} 12545}
2132     foo
2133 } 0
2134 test string-11.23 {string match} {
2135     proc foo {} {string match {a\*b} a*b}
2136     foo
2137 } 1
2138 test string-11.24 {string match} {
2139     proc foo {} {string match {a\*b} ab}
2140     foo
2141 } 0
2142 test string-11.25 {string match} {
2143     proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
2144     foo
2145 } 1
2146 test string-11.26 {string match} {
2147     proc foo {} {string match ** ""}
2148     foo
2149 } 1
2150 test string-11.27 {string match} {
2151     proc foo {} {string match *. ""}
2152     foo
2153 } 0
2154 test string-11.28 {string match} {
2155     proc foo {} {string match "" ""}
2156     foo
2157 } 1
2158 test string-11.29 {string match} {
2159     proc foo {} {string match \[a a}
2160     foo
2161 } 1
2162 test string-11.31 {string match case} {
2163     proc foo {} {string match a A}
2164     foo
2165 } 0
2166 test string-11.32 {string match nocase} {
2167     proc foo {} {string match -n a A}
2168     foo
2169 } 1
2170 #test string-11.33 {string match nocase} {
2171 #    proc foo {} {string match -nocase a\334 A\374}
2172 #    foo
2173 #} 1
2174 test string-11.34 {string match nocase} {
2175     proc foo {} {string match -nocase a*f ABCDEf}
2176     foo
2177 } 1
2178 test string-11.35 {string match case, false hope} {
2179     # This is true because '_' lies between the A-Z and a-z ranges
2180     proc foo {} {string match {[A-z]} _}
2181     foo
2182 } 1
2183 test string-11.36 {string match nocase range} {
2184     # This is false because although '_' lies between the A-Z and a-z ranges,
2185     # we lower case the end points before checking the ranges.
2186     proc foo {} {string match -nocase {[A-z]} _}
2187     foo
2188 } 0
2189 test string-11.37 {string match nocase} {
2190     proc foo {} {string match -nocase {[A-fh-Z]} g}
2191     foo
2192 } 0
2193 test string-11.38 {string match case, reverse range} {
2194     proc foo {} {string match {[A-fh-Z]} g}
2195     foo
2196 } 1
2197 test string-11.39 {string match, *\ case} {
2198     proc foo {} {string match {*\abc} abc}
2199     foo
2200 } 1
2201 test string-11.40 {string match, *special case} {
2202     proc foo {} {string match {*[ab]} abc}
2203     foo
2204 } 0
2205 test string-11.41 {string match, *special case} {
2206     proc foo {} {string match {*[ab]*} abc}
2207     foo
2208 } 1
2209 #test string-11.42 {string match, *special case} {
2210 #    proc foo {} {string match "*\\" "\\"}
2211 #    foo
2212 #} 0
2213 test string-11.43 {string match, *special case} {
2214     proc foo {} {string match "*\\\\" "\\"}
2215     foo
2216 } 1
2217 test string-11.44 {string match, *special case} {
2218     proc foo {} {string match "*???" "12345"}
2219     foo
2220 } 1
2221 test string-11.45 {string match, *special case} {
2222     proc foo {} {string match "*???" "12"}
2223     foo
2224 } 0
2225 test string-11.46 {string match, *special case} {
2226     proc foo {} {string match "*\\*" "abc*"}
2227     foo
2228 } 1
2229 test string-11.47 {string match, *special case} {
2230     proc foo {} {string match "*\\*" "*"}
2231     foo
2232 } 1
2233 test string-11.48 {string match, *special case} {
2234     proc foo {} {string match "*\\*" "*abc"}
2235     foo
2236 } 0
2237 test string-11.49 {string match, *special case} {
2238     proc foo {} {string match "?\\*" "a*"}
2239     foo
2240 } 1
2241 #test string-11.50 {string match, *special case} {
2242 #    proc foo {} {string match "\\" "\\"}
2243 #    foo
2244 #} 0
2246 ## string length
2248 test string-9.1 {string length} {
2249     proc foo {} {string length}
2250     list [catch {foo} msg] $msg
2251 } {1 {wrong # args: should be "string length string"}}
2252 test string-9.2 {string length} {
2253     proc foo {} {string length a b}
2254     list [catch {foo} msg] $msg
2255 } {1 {wrong # args: should be "string length string"}}
2256 test string-9.3 {string length} {
2257     proc foo {} {string length "a little string"}
2258     foo
2259 } 15
2261 # string map
2263 test string-10.4 {string map} {
2264     string map {a b} abba
2265 } {bbbb}
2266 test string-10.5 {string map} {
2267     string map {a b} a
2268 } {b}
2269 test string-10.6 {string map -nocase} {
2270     string map -nocase {a b} Abba
2271 } {bbbb}
2272 test string-10.7 {string map} {
2273     string map {abc 321 ab * a A} aabcabaababcab
2274 } {A321*A*321*}
2275 test string-10.8 {string map -nocase} {
2276     string map -nocase {aBc 321 Ab * a A} aabcabaababcab
2277 } {A321*A*321*}
2278 test string-10.10 {string map} {
2279     list [catch {string map {a b c} abba} msg] $msg
2280 } {1 {list must contain an even number of elements}}
2281 test string-10.11 {string map, nulls} {
2282     string map {\x00 NULL blah \x00nix} {qwerty}
2283 } {qwerty}
2284 test string-10.12 {string map, unicode} {
2285     string map [list \u00fc ue UE \u00dc] "a\u00fcueUE\000EU"
2286 } aueue\u00dc\0EU
2287 test string-10.13 {string map, -nocase unicode} {
2288     string map -nocase [list \u00fc ue UE \u00dc] "a\u00fcueUE\000EU"
2289 } aue\u00dc\u00dc\0EU
2290 test string-10.14 {string map, -nocase null arguments} {
2291     string map -nocase {{} abc} foo
2292 } foo
2293 test string-10.15 {string map, one pair case} {
2294     string map -nocase {abc 32} aAbCaBaAbAbcAb
2295 } {a32aBaAb32Ab}
2296 test string-10.16 {string map, one pair case} {
2297     string map -nocase {ab 4321} aAbCaBaAbAbcAb
2298 } {a4321C4321a43214321c4321}
2299 test string-10.17 {string map, one pair case} {
2300     string map {Ab 4321} aAbCaBaAbAbcAb
2301 } {a4321CaBa43214321c4321}
2302 test string-10.18 {string map, empty argument} {
2303     string map -nocase {{} abc} foo
2304 } foo
2305 test string-10.19 {string map, empty arguments} {
2306     string map -nocase {{} abc f bar {} def} foo
2307 } baroo
2309 ################################################################################
2310 # SPLIT
2311 ################################################################################
2313 test split-1.1 {basic split commands} {
2314     split "a\n b\t\r c\n "
2315 } {a {} b {} {} c {} {}}
2316 test split-1.2 {basic split commands} {
2317     split "word 1xyzword 2zword 3" xyz
2318 } {{word 1} {} {} {word 2} {word 3}}
2319 test split-1.3 {basic split commands} {
2320     split "12345" {}
2321 } {1 2 3 4 5}
2322 test split-1.4 {basic split commands} {
2323     split "a\}b\[c\{\]\$"
2324 } "a\\}b\\\[c\\{\\\]\\\$"
2325 test split-1.5 {basic split commands} {
2326     split {} {}
2327 } {}
2328 test split-1.6 {basic split commands} {
2329     split {}
2330 } {}
2331 test split-1.7 {basic split commands} {
2332     split {   }
2333 } {{} {} {} {}}
2334 test split-1.8 {basic split commands} {
2335     proc foo {} {
2336         set x {}
2337         foreach f [split {]\n} {}] {
2338             append x $f
2339         }
2340         return $x       
2341     }
2342     foo
2343 } {]\n}
2344 test split-1.9 {basic split commands} {
2345     proc foo {} {
2346         set x ab\000c
2347         set y [split $x {}]
2348         return $y
2349     }
2350     foo
2351 } "a b \000 c"
2352 test split-1.10 {basic split commands} {
2353     split "a0ab1b2bbb3\000c4" ab\000c
2354 } {{} 0 {} 1 2 {} {} 3 {} 4}
2355 test split-1.11 {basic split commands} {
2356     split "12,3,45" {,}
2357 } {12 3 45}
2358 test split-1.12 {basic split commands} {
2359     split "\u0001ab\u0001cd\u0001\u0001ef\u0001" \1
2360 } {{} ab cd {} ef {}}
2361 test split-1.13 {basic split commands} {
2362     split "12,34,56," {,}
2363 } {12 34 56 {}}
2364 test split-1.14 {basic split commands} {
2365     split ",12,,,34,56," {,}
2366 } {{} 12 {} {} 34 56 {}}
2368 test split-2.1 {split errors} {
2369     list [catch split msg] $msg
2370 } {1 {wrong # args: should be "split string ?splitChars?"}}
2371 test split-2.2 {split errors} {
2372     list [catch {split a b c} msg] $msg
2373 } {1 {wrong # args: should be "split string ?splitChars?"}}
2375 # cleanup
2376 catch {rename foo {}}
2378 ################################################################################
2379 # JOIN
2380 ################################################################################
2382 test join-1.1 {basic join commands} {
2383     join {a b c} xyz
2384 } axyzbxyzc
2385 test join-1.2 {basic join commands} {
2386     join {a b c} {}
2387 } abc
2388 test join-1.3 {basic join commands} {
2389     join {} xyz
2390 } {}
2391 test join-1.4 {basic join commands} {
2392     join {12 34 56}
2393 } {12 34 56}
2395 test join-2.1 {join errors} {
2396     list [catch join msg] $msg
2397 } {1 {wrong # args: should be "join list ?joinString?"}}
2398 test join-2.2 {join errors} {
2399     list [catch {join a b c} msg] $msg
2400 } {1 {wrong # args: should be "join list ?joinString?"}}
2401 #test join-2.3 {join errors} {
2402 #    list [catch {join "a \{ c" 111} msg] $msg
2403 #} {1 {unmatched open brace in list}}
2405 test join-3.1 {joinString is binary ok} {
2406   string length [join {a b c} a\0b]
2407 } 9
2409 test join-3.2 {join is binary ok} {
2410   string length [join "a\0b a\0b a\0b"]
2411 } 11
2413 ################################################################################
2414 # SWITCH
2415 ################################################################################
2417 test switch-1.1 {simple patterns} {
2418     switch a a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2419 } 1
2420 test switch-1.2 {simple patterns} {
2421     switch b a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2422 } 2
2423 test switch-1.3 {simple patterns} {
2424     switch x a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2425 } 4
2426 test switch-1.4 {simple patterns} {
2427     switch x a {expr 1} b {expr 2} c {expr 3}
2428 } {}
2429 test switch-1.5 {simple pattern matches many times} {
2430     switch b a {expr 1} b {expr 2} b {expr 3} b {expr 4}
2431 } 2
2432 test switch-1.6 {simple patterns} {
2433     switch default a {expr 1} default {expr 2} c {expr 3} default {expr 4}
2434 } 2
2435 test switch-1.7 {simple patterns} {
2436     switch x a {expr 1} default {expr 2} c {expr 3} default {expr 4}
2437 } 4
2439 test switch-2.1 {single-argument form for pattern/command pairs} {
2440     switch b {
2441         a {expr 1}
2442         b {expr 2}
2443         default {expr 6}
2444     }
2445 } {2}
2446 test switch-2.2 {single-argument form for pattern/command pairs} {
2447     list [catch {switch z {a 2 b}}]
2448 } 1
2450 test switch-3.1 {-exact vs. -glob vs. -regexp} {
2451     switch -exact aaaab {
2452         ^a*b$   {concat regexp}
2453         *b      {concat glob}
2454         aaaab   {concat exact}
2455         default {concat none}
2456     }
2457 } exact
2458 test switch-3.2 {-exact vs. -glob vs. -regexp (no [regexp] cmd)} regexp {
2459         rename regexp regexp.none
2460     set rc [catch {
2461         switch -regexp aaaab {
2462         ^a*b$   {concat regexp}
2463         *b      {concat glob}
2464         aaaab   {concat exact}
2465         default {concat none}
2466         }
2467     }]
2468         rename regexp.none regexp
2469         set rc
2470 } 1
2472 test switch-3.3 {-exact vs. -glob vs. -regexp (with [regexp] cmd)} regexp {
2473     switch -regexp aaaab {
2474         ^a*b$   {concat regexp}
2475         *b          {concat glob}
2476         aaaab   {concat exact}
2477         default {concat none}
2478     }
2479 } regexp
2480 test switch-3.4 {-exact vs. -glob vs. -regexp} {
2481     switch -glob aaaab {
2482         ^a*b$   {concat regexp}
2483         *b          {concat glob}
2484         aaaab   {concat exact}
2485         default {concat none}
2486     }
2487 } glob
2488 test switch-3.5 {-exact vs. -glob vs. -regexp} {
2489     switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
2490             aaaab {concat exact} default {concat none}
2491 } exact
2492 test switch-3.6 {-exact vs. -glob vs. -regexp} {
2493     switch -- -glob {
2494         ^g.*b$  {concat regexp}
2495         -*      {concat glob}
2496         -glob   {concat exact}
2497         default {concat none}
2498     }
2499 } exact
2500 test switch-3.7 {-exact vs. -glob vs. -regexp} {
2501     list [catch {switch -foo a b c} msg] $msg
2502 } {1 {bad option "-foo": must be -exact, -glob, -regexp, -command procname or --}}
2504 test switch-4.1 {error in executed command} {
2505     list [catch {switch a a {error "Just a test"} default {expr 1}} msg] \
2506             $msg
2507 } {1 {Just a test}}
2508 test switch-4.2 {error: not enough args} {
2509     catch {switch}
2510 } 1
2511 test switch-4.3 {error: pattern with no body} {
2512     catch {switch a b}
2513 } 1
2514 test switch-4.4 {error: pattern with no body} {
2515     catch {switch a b {expr 1} c}
2516 } 1
2517 test switch-4.5 {error in default command} {
2518     list [catch {switch foo a {error switch1} b {error switch 3} \
2519             default {error switch2}} msg] $msg
2520 } {1 switch2}
2522 test switch-5.1 {errors in -regexp matching} regexp {
2523     catch {switch -regexp aaaab {
2524         *b      {concat glob}
2525         aaaab   {concat exact}
2526         default {concat none}
2527     }} msg
2528 } 1
2530 test switch-6.1 {backslashes in patterns} {
2531     switch -exact {\a\$\.\[} {
2532         \a\$\.\[        {concat first}
2533         \a\\$\.\\[      {concat second}
2534         \\a\\$\\.\\[    {concat third}
2535         {\a\\$\.\\[}    {concat fourth}
2536         {\\a\\$\\.\\[}  {concat fifth}
2537         default         {concat none}
2538     }
2539 } third
2540 test switch-6.2 {backslashes in patterns} {
2541     switch -exact {\a\$\.\[} {
2542         \a\$\.\[        {concat first}
2543         {\a\$\.\[}      {concat second}
2544         {{\a\$\.\[}}    {concat third}
2545         default         {concat none}
2546     }
2547 } second
2549 test switch-7.1 {"-" bodies} {
2550     switch a {
2551         a -
2552         b -
2553         c {concat 1}
2554         default {concat 2}
2555     }
2556 } 1
2557 test switch-7.2 {"-" bodies} {
2558     list [catch {
2559         switch a {
2560             a -
2561             b -
2562             c -
2563         }
2564     } msg] $msg
2565 } {1 {no body specified for pattern "c"}}
2566 # Following original Tcl test makes no sense, I feel! Please review ...
2567 #~ test switch-7.3 {"-" bodies} {
2568     #~ list [catch {
2569         #~ switch a {
2570             #~ a -
2571             #~ b -foo
2572             #~ c -
2573         #~ }
2574     #~ } msg] $msg
2575 #~ } {1 {no body specified for pattern "c"}}
2576 test switch-7.3 {"-" bodies} {
2577     list [catch {
2578         switch a {
2579             a -
2580             b -foo
2581             c -
2582         }
2583     } msg] $msg
2584 } {1 {invalid command name "-foo"}}
2586 test switch-8.1 {empty body} {
2587     set msg {}
2588     switch {2} {
2589         1 {set msg 1}
2590         2 {}
2591         default {set msg 2}
2592     }
2593 } {}
2595 test switch-9.1 {empty pattern/body list} {
2596     catch {switch x}
2597 } 1
2598 test switch-9.2 {empty pattern/body list} {
2599     catch {switch -- x} 
2600 } 1 
2601 test switch-9.3 {empty pattern/body list} {
2602     catch {switch x {}} 
2603 } 1
2604 test switch-9.4 {empty pattern/body list} {
2605     catch {switch -- x {}}
2606 } 1
2607 test switch-9.5 {unpaired pattern} {
2608     catch {switch x a {} b}
2609 } 1
2610 test switch-9.6 {unpaired pattern} {
2611     catch {switch x {a {} b}}
2612 } 1
2613 test switch-9.7 {unpaired pattern} {
2614     catch {switch x a {} # comment b}
2615 } 1
2616 test switch-9.8 {unpaired pattern} {
2617     catch {switch x {a {} # comment b}}
2618 } 1
2619 test switch-9.9 {unpaired pattern} {
2620     catch {switch x a {} x {} # comment b}
2621 } 1
2622 test switch-9.10 {unpaired pattern} {
2623     catch {switch x {a {} x {} # comment b}}
2624 } 1
2626 test switch-10.1 {no callback given to -command} {
2627     catch {switch -command a { a {expr 1} b {expr 2} }} 
2628 } 1
2629 test switch-10.2 {callback expect wrong # args for -command} lambda {
2630     catch {switch -command [lambda {p1} {expr 1}] a { a {expr 1} b {expr 2} }}
2631 } 1
2632 test switch-10.3 {callback to -command returns ever 0: no match} lambda {
2633     switch -command [lambda {p1 p2} {expr 0}] a a {expr 1} b {expr 2}
2634 } {}
2635 test switch-10.4 {callback to -command returns 3 at first match} lambda {
2636     switch -command [lambda {p1 p2} {expr 3}] a a {expr 1} b {expr 2}
2637 } 1
2638 test switch-10.5 {[error] in callback to -command} lambda {
2639     list [catch {
2640         switch -command [lambda {p1 p2} {error "foo"}] a a {expr 1} b {expr 2}
2641     } msg] $msg
2642 } {1 foo}
2643 test switch-10.6 {[continue] in callback to -command} lambda {
2644     list [catch {
2645         switch -command [lambda {p1 p2} {continue}] a a {expr 1} b {expr 2}
2646     } msg] $msg
2647 } {4 {}}
2648 test switch-10.7 {callback matches first if pat < str} lambda {
2649     switch -command [lambda {pat str} {expr {$pat < $str}}] 3 \
2650         5 {expr 1} 3 {expr 2}
2651 } {}
2652 test switch-10.8 {callback matches first if pat < str} lambda {
2653     switch -command [lambda {pat str} {expr {$pat < $str}}] 7 \
2654         5 {expr 1} 3 {expr 2}
2655 } 1
2656 test switch-10.9 {callback matches first if pat < str} lambda {
2657     switch -command [lambda {pat str} {expr {$pat < $str}}] 4 \
2658         5 {expr 1} 3 {expr 2}
2659 } 2
2661 ################################################################################
2662 # FOR
2663 ################################################################################
2665 # Basic "for" operation.
2666 test for-1.1 {TclCompileForCmd: missing initial command} {
2667     list [catch {for} msg] $msg
2668 } {1 {wrong # args: should be "for start test next body"}}
2669 test for-1.2 {TclCompileForCmd: error in initial command} {
2670     list [catch {for {set}} msg] $msg
2671 } {1 {wrong # args: should be "for start test next body"}}
2672 catch {unset i}
2673 test for-1.3 {TclCompileForCmd: missing test expression} {
2674     catch {for {set i 0}} msg
2675     set msg
2676 } {wrong # args: should be "for start test next body"}
2677 test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
2678     set i 0
2679     for {} "$i > 5" {incr i} {}
2680 } {}
2681 test for-1.6 {TclCompileForCmd: missing "next" command} {
2682     catch {for {set i 0} {$i < 5}} msg
2683     set msg
2684 } {wrong # args: should be "for start test next body"}
2685 test for-1.7 {TclCompileForCmd: missing command body} {
2686     catch {for {set i 0} {$i < 5} {incr i}} msg
2687     set msg
2688 } {wrong # args: should be "for start test next body"}
2689 catch {unset a}
2690 test for-1.9 {TclCompileForCmd: simple command body} {
2691     set a {}
2692     for {set i 1} {$i<6} {set i [expr $i+1]} {
2693         if $i==4 break
2694         set a [concat $a $i]
2695     }
2696     set a
2697 } {1 2 3}
2698 test for-1.10 {TclCompileForCmd: command body in quotes} {
2699     set a {}
2700     for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2701     set a
2702 } {xxxxx}
2703 test for-1.11 {TclCompileForCmd: computed command body} {
2704     catch {unset x1}
2705     catch {unset bb}
2706     catch {unset x2}
2707     set x1 {append a x1; }
2708     set bb {break}
2709     set x2 {; append a x2}
2710     set a {}
2711     for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
2712     set a
2713 } {x1}
2714 test for-1.13 {TclCompileForCmd: long command body} {
2715     set a {}
2716     for {set i 1} {$i<6} {set i [expr $i+1]} {
2717         if $i==4 break
2718         if $i>5 continue
2719         set tcl_platform(machine) i686
2720         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2721             catch {set a $a} msg
2722             catch {incr i 5} msg
2723             catch {incr i -5} msg
2724         }
2725         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2726             catch {set a $a} msg
2727             catch {incr i 5} msg
2728             catch {incr i -5} msg
2729         }
2730         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2731             catch {set a $a} msg
2732             catch {incr i 5} msg
2733             catch {incr i -5} msg
2734         }
2735         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2736             catch {set a $a} msg
2737             catch {incr i 5} msg
2738             catch {incr i -5} msg
2739         }
2740         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2741             catch {set a $a} msg
2742             catch {incr i 5} msg
2743             catch {incr i -5} msg
2744         }
2745         set a [concat $a $i]
2746     }
2747     set a
2748 } {1 2 3}
2749 test for-1.14 {TclCompileForCmd: for command result} {
2750     set a [for {set i 0} {$i < 5} {incr i} {}]
2751     set a
2752 } {}
2753 test for-1.15 {TclCompileForCmd: for command result} {
2754     set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
2755     set a
2756 } {}
2758 # Check "for" and "continue".
2760 test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
2761     catch {continue foo} msg
2762     set msg
2763 } {wrong # args: should be "continue"}
2764 test for-2.2 {TclCompileContinueCmd: continue result} {
2765     catch continue
2766 } 4
2767 test for-2.3 {continue tests} {
2768     set a {}
2769     for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2770         if {$i == 2} continue
2771         set a [concat $a $i]
2772     }
2773     set a
2774 } {1 3 4}
2775 test for-2.4 {continue tests} {
2776     set a {}
2777     for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2778         if {$i != 2} continue
2779         set a [concat $a $i]
2780     }
2781     set a
2782 } {2}
2783 test for-2.5 {continue tests, nested loops} {
2784     set msg {}
2785     for {set i 1} {$i <= 4} {incr i} {
2786         for {set a 1} {$a <= 2} {incr a} {
2787             if {$i>=2 && $a>=2} continue
2788             set msg [concat $msg "$i.$a"]
2789         }
2790     }
2791     set msg
2792 } {1.1 1.2 2.1 3.1 4.1}
2793 test for-2.6 {continue tests, long command body} {
2794     set a {}
2795     for {set i 1} {$i<6} {set i [expr $i+1]} {
2796         if $i==2 continue
2797         if $i==4 break
2798         if $i>5 continue
2799         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2800             catch {set a $a} msg
2801             catch {incr i 5} msg
2802             catch {incr i -5} msg
2803         }
2804         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2805             catch {set a $a} msg
2806             catch {incr i 5} msg
2807             catch {incr i -5} msg
2808         }
2809         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2810             catch {set a $a} msg
2811             catch {incr i 5} msg
2812             catch {incr i -5} msg
2813         }
2814         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2815             catch {set a $a} msg
2816             catch {incr i 5} msg
2817             catch {incr i -5} msg
2818         }
2819         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2820             catch {set a $a} msg
2821             catch {incr i 5} msg
2822             catch {incr i -5} msg
2823         }
2824         set a [concat $a $i]
2825     }
2826     set a
2827 } {1 3}
2829 # Check "for" and "break".
2831 test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
2832     catch {break foo} msg
2833     set msg
2834 } {wrong # args: should be "break"}
2835 test for-3.2 {TclCompileBreakCmd: break result} {
2836     catch break
2837 } 3
2838 test for-3.3 {break tests} {
2839     set a {}
2840     for {set i 1} {$i <= 4} {incr i} {
2841         if {$i == 3} break
2842         set a [concat $a $i]
2843     }
2844     set a
2845 } {1 2}
2846 test for-3.4 {break tests, nested loops} {
2847     set msg {}
2848     for {set i 1} {$i <= 4} {incr i} {
2849         for {set a 1} {$a <= 2} {incr a} {
2850             if {$i>=2 && $a>=2} break
2851             set msg [concat $msg "$i.$a"]
2852         }
2853     }
2854     set msg
2855 } {1.1 1.2 2.1 3.1 4.1}
2856 test for-3.5 {break tests, long command body} {
2857     set a {}
2858     for {set i 1} {$i<6} {set i [expr $i+1]} {
2859         if $i==2 continue
2860         if $i==5 break
2861         if $i>5 continue
2862         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2863             catch {set a $a} msg
2864             catch {incr i 5} msg
2865             catch {incr i -5} msg
2866         }
2867         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2868             catch {set a $a} msg
2869             catch {incr i 5} msg
2870             catch {incr i -5} msg
2871         }
2872         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2873             catch {set a $a} msg
2874             catch {incr i 5} msg
2875             catch {incr i -5} msg
2876         }
2877         if {$i == 4} break
2878         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2879             catch {set a $a} msg
2880             catch {incr i 5} msg
2881             catch {incr i -5} msg
2882         }
2883         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2884             catch {set a $a} msg
2885             catch {incr i 5} msg
2886             catch {incr i -5} msg
2887         }
2888         set a [concat $a $i]
2889     }
2890     set a
2891 } {1 3}
2892 test for-4.1 {break must reset the interp result} {
2893     catch {
2894         set z GLOBTESTDIR/dir2/file2.c
2895         if [string match GLOBTESTDIR/dir2/* $z] {
2896             break
2897         }
2898     } j
2899     set j
2900 } {}
2902 # Test for incorrect "double evaluation" semantics
2904 test for-5.1 {possible delayed substitution of increment command} {
2905     # Increment should be 5, and lappend should always append $a
2906     catch {unset a}
2907     catch {unset i}
2908     set a 5
2909     set i {}
2910     for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2911     set i
2912 } {1 6 11}
2914 test for-5.2 {possible delayed substitution of increment command} {
2915     # Increment should be 5, and lappend should always append $a
2916     catch {rename p ""}
2917     proc p {} {
2918         set a 5
2919         set i {}
2920         for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2921         set i
2922     }
2923     p
2924 } {1 6 11}
2925 test for-5.3 {possible delayed substitution of body command} {
2926     # Increment should be $a, and lappend should always append 5
2927     set a 5
2928     set i {}
2929     for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2930     set i
2931 } {5 5 5 5}
2932 test for-5.4 {possible delayed substitution of body command} {
2933     # Increment should be $a, and lappend should always append 5
2934     catch {rename p ""}
2935     proc p {} {
2936         set a 5
2937         set i {}
2938         for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2939         set i
2940     }
2941     p
2942 } {5 5 5 5}
2944 # In the following tests we need to bypass the bytecode compiler by
2945 # substituting the command from a variable.  This ensures that command
2946 # procedure is invoked directly.
2948 test for-6.1 {Tcl_ForObjCmd: number of args} {
2949     set z for
2950     catch {$z} msg
2951     set msg
2952 } {wrong # args: should be "for start test next body"}
2953 test for-6.2 {Tcl_ForObjCmd: number of args} {
2954     set z for
2955     catch {$z {set i 0}} msg
2956     set msg
2957 } {wrong # args: should be "for start test next body"}
2958 test for-6.3 {Tcl_ForObjCmd: number of args} {
2959     set z for
2960     catch {$z {set i 0} {$i < 5}} msg
2961     set msg
2962 } {wrong # args: should be "for start test next body"}
2963 test for-6.4 {Tcl_ForObjCmd: number of args} {
2964     set z for
2965     catch {$z {set i 0} {$i < 5} {incr i}} msg
2966     set msg
2967 } {wrong # args: should be "for start test next body"}
2968 test for-6.5 {Tcl_ForObjCmd: number of args} {
2969     set z for
2970     catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
2971     set msg
2972 } {wrong # args: should be "for start test next body"}
2973 test for-6.6 {Tcl_ForObjCmd: error in initial command} {
2974     set z for
2975     list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg
2976 } {1 {wrong # args: should be "set varName ?newValue?"}}
2977 test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
2978     set z for
2979     set i 0
2980     $z {set i 6} "$i > 5" {incr i} {set y $i}
2981     set i
2982 } 6
2983 test for-6.10 {Tcl_ForObjCmd: simple command body} {
2984     set z for
2985     set a {}
2986     $z {set i 1} {$i<6} {set i [expr $i+1]} {
2987         if $i==4 break
2988         set a [concat $a $i]
2989     }
2990     set a
2991 } {1 2 3}
2992 test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
2993     set z for
2994     set a {}
2995     $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2996     set a
2997 } {xxxxx}
2998 test for-6.12 {Tcl_ForObjCmd: computed command body} {
2999     set z for
3000     catch {unset x1}
3001     catch {unset bb}
3002     catch {unset x2}
3003     set x1 {append a x1; }
3004     set bb {break}
3005     set x2 {; append a x2}
3006     set a {}
3007     $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
3008     set a
3009 } {x1}
3010 test for-6.14 {Tcl_ForObjCmd: long command body} {
3011     set z for
3012     set a {}
3013     $z {set i 1} {$i<6} {set i [expr $i+1]} {
3014         if $i==4 break
3015         if $i>5 continue
3016         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3017             catch {set a $a} msg
3018             catch {incr i 5} msg
3019             catch {incr i -5} msg
3020         }
3021         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3022             catch {set a $a} msg
3023             catch {incr i 5} msg
3024             catch {incr i -5} msg
3025         }
3026         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3027             catch {set a $a} msg
3028             catch {incr i 5} msg
3029             catch {incr i -5} msg
3030         }
3031         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3032             catch {set a $a} msg
3033             catch {incr i 5} msg
3034             catch {incr i -5} msg
3035         }
3036         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3037             catch {set a $a} msg
3038             catch {incr i 5} msg
3039             catch {incr i -5} msg
3040         }
3041         set a [concat $a $i]
3042     }
3043     set a
3044 } {1 2 3}
3045 test for-6.15 {Tcl_ForObjCmd: for command result} {
3046     set z for
3047     set a [$z {set i 0} {$i < 5} {incr i} {}]
3048     set a
3049 } {}
3050 test for-6.16 {Tcl_ForObjCmd: for command result} {
3051     set z for
3052     set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
3053     set a
3054 } {}
3057 ################################################################################
3058 # INFO
3059 ################################################################################
3061 test info-1.1 {info body option} {
3062     proc t1 {} {body of t1}
3063     info body t1
3064 } {body of t1}
3065 test info-1.2 {info body option} {
3066     list [catch {info body set} msg] $msg
3067 } {1 {command "set" is not a procedure}}
3068 test info-1.3 {info body option} {
3069     list [catch {info args set 1} msg] $msg
3070 } {1 {wrong # args: should be "info args procname"}}
3071 test info-1.5 {info body option, returning bytecompiled bodies} {
3072     catch {unset args}
3073     proc foo {args} {
3074         foreach v $args {
3075             upvar $v var
3076             return "variable $v existence: [info exists var]"
3077         }
3078     }
3079     foo a
3080     list [catch [info body foo] msg] $msg
3081 } {1 {can't read "args": no such variable}}
3082 test info-1.6 {info body option, returning list bodies} {
3083     proc foo args [list subst bar]
3084     list [string length [info body foo]] \
3085             [foo; string length [info body foo]]
3086 } {9 9}
3087 test info-2.1 {info commands option} {
3088     proc t1 {} {}
3089     proc t2 {} {}
3090     set x " [info commands] "
3091     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
3092             [string match {* set *} $x] [string match {* list *} $x]
3093 } {1 1 1 1}
3094 test info-2.2 {info commands option} {
3095     proc t1 {} {}
3096     rename t1 {}
3097     set x [info commands]
3098     string match {* t1 *} $x
3099 } 0
3100 test info-2.3 {info commands option} {
3101     proc _test1_ {} {}
3102     proc _test2_ {} {}
3103     info commands _test1_
3104 } _test1_
3105 test info-2.4 {info commands option} {
3106     proc _test1_ {} {}
3107     proc _test2_ {} {}
3108     lsort [info commands _test*]
3109 } {_test1_ _test2_}
3110 catch {rename _test1_ {}}
3111 catch {rename _test2_ {}}
3112 test info-2.5 {info commands option} {
3113     list [catch {info commands a b} msg] $msg
3114 } {1 {wrong # args: should be "info commands ?pattern?"}}
3115 test info-3.1 {info exists option} {
3116     set value foo
3117     info exists value
3118 } 1
3119 catch {unset _nonexistent_}
3120 test info-3.2 {info exists option} {
3121     info exists _nonexistent_
3122 } 0
3123 test info-3.3 {info exists option} {
3124     proc t1 {x} {return [info exists x]}
3125     t1 2
3126 } 1
3127 test info-3.4 {info exists option} {
3128     proc t1 {x} {
3129         global _nonexistent_
3130         return [info exists _nonexistent_]
3131     }
3132     t1 2
3133 } 0
3134 test info-3.5 {info exists option} {
3135     proc t1 {x} {
3136         set y 47
3137         return [info exists y]
3138     }
3139     t1 2
3140 } 1
3141 test info-3.6 {info exists option} {
3142     proc t1 {x} {return [info exists value]}
3143     t1 2
3144 } 0
3145 test info-3.7 {info exists option} {
3146     catch {unset x}
3147     set x(2) 44
3148     list [info exists x] [info exists x(1)] [info exists x(2)]
3149 } {1 0 1}
3150 catch {unset x}
3151 test info-3.8 {info exists option} {
3152     list [catch {info exists} msg] $msg
3153 } {1 {wrong # args: should be "info exists varName"}}
3154 test info-3.9 {info exists option} {
3155     list [catch {info exists 1 2} msg] $msg
3156 } {1 {wrong # args: should be "info exists varName"}}
3157 test info-4.1 {info globals option} {
3158     set x 1
3159     set y 2
3160     set value 23
3161     set a " [info globals] "
3162     list [string match {* x *} $a] [string match {* y *} $a] \
3163             [string match {* value *} $a] [string match {* _foobar_ *} $a]
3164 } {1 1 1 0}
3165 test info-4.2 {info globals option} {
3166     set _xxx1 1
3167     set _xxx2 2
3168     lsort [info globals _xxx*]
3169 } {_xxx1 _xxx2}
3170 test info-4.3 {info globals option} {
3171     list [catch {info globals 1 2} msg] $msg
3172 } {1 {wrong # args: should be "info globals ?pattern?"}}
3173 test info-5.1 {info level option} {
3174     info level
3175 } 0
3177 test info-5.2 {info level option} {
3178     proc t1 {a b} {
3179         set x [info level]
3180         set y [info level 1]
3181         list $x $y
3182     }
3183     t1 146 testString
3184 } {1 {t1 146 testString}}
3185 test info-5.3 {info level option} {
3186     proc t1 {a b} {
3187         t2 [expr $a*2] $b
3188     }
3189     proc t2 {x y} {
3190         list [info level] [info level 1] [info level 2] [info level -1] \
3191                 [info level 0]
3192     }
3193     t1 146 {a {b c} {{{c}}}}
3194 } {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}
3195 test info-5.4 {info level option} {
3196     proc t1 {} {
3197         set x [info level]
3198         set y [info level 1]
3199         list $x $y
3200     }
3201     t1
3202 } {1 t1}
3203 test info-5.5 {info level option} {
3204     list [catch {info level 1 2} msg] $msg
3205 } {1 {wrong # args: should be "info level ?levelNum?"}}
3206 test info-5.6 {info level option} {
3207     list [catch {info level 123a} msg] $msg
3208 } {1 {bad level "123a"}}
3209 test info-5.7 {info level option} {
3210     list [catch {info level 0} msg] $msg
3211 } {1 {bad level "0"}}
3212 test info-5.8 {info level option} {
3213     proc t1 {} {info level -1}
3214     list [catch {t1} msg] $msg
3215 } {1 {bad level "-1"}}
3216 test info-5.9 {info level option} {
3217     proc t1 {x} {info level $x}
3218     list [catch {t1 -3} msg] $msg
3219 } {1 {bad level "-3"}}
3220 test info-6.1 {info locals option} {
3221     set a 22
3222     proc t1 {x y} {
3223         set b 13
3224         set c testing
3225         global a
3226         global aa
3227         set aa 23
3228         return [info locals]
3229     }
3230     lsort [t1 23 24]
3231 } {b c x y}
3232 test info-6.2 {info locals option} {
3233     proc t1 {x y} {
3234         set xx1 2
3235         set xx2 3
3236         set y 4
3237         return [info locals x*]
3238     }
3239     lsort [t1 2 3]
3240 } {x xx1 xx2}
3241 test info-6.3 {info locals option} {
3242     list [catch {info locals 1 2} msg] $msg
3243 } {1 {wrong # args: should be "info locals ?pattern?"}}
3244 test info-6.4 {info locals option} {
3245     info locals
3246 } {}
3247 test info-6.5 {info locals option} {
3248     proc t1 {} {return [info locals]}
3249     t1
3250 } {}
3251 test info-6.6 {info locals vs unset compiled locals} {
3252     proc t1 {lst} {
3253         foreach $lst $lst {}
3254         unset lst
3255         return [info locals]
3256     }
3257     lsort [t1 {a b c c d e f}]
3258 } {a b c d e f}
3259 test info-6.7 {info locals with temporary variables} {
3260     proc t1 {} {
3261         foreach a {b c} {}
3262         info locals
3263     }
3264     t1
3265 } {a}
3266 test info-7.1 {info vars option} {
3267     set a 1
3268     set b 2
3269     proc t1 {x y} {
3270         global a b
3271         set c 33
3272         return [info vars]
3273     }
3274     lsort [t1 18 19]
3275 } {a b c x y}
3276 test info-7.2 {info vars option} {
3277     set xxx1 1
3278     set xxx2 2
3279     proc t1 {xxa y} {
3280         global xxx1 xxx2
3281         set c 33
3282         return [info vars x*]
3283     }
3284     lsort [t1 18 19]
3285 } {xxa xxx1 xxx2}
3286 test info-7.3 {info vars option} {
3287     lsort [info vars]
3288 } [lsort [info globals]]
3289 test info-7.4 {info vars option} {
3290     list [catch {info vars a b} msg] $msg
3291 } {1 {wrong # args: should be "info vars ?pattern?"}}
3292 test info-7.5 {info vars with temporary variables} {
3293     proc t1 {} {
3294         foreach a {b c} {}
3295         info vars
3296     }
3297     t1
3298 } {a}
3300 ################################################################################
3301 # RANGE
3302 ################################################################################
3304 test range-1.1 {basic range tests} {
3305     range 0 10
3306 } {0 1 2 3 4 5 6 7 8 9}
3308 test range-1.2 {basic range tests} {
3309     range 10 0 -1
3310 } {10 9 8 7 6 5 4 3 2 1}
3312 test range-1.3 {basic range tests} {
3313     range 1 10 11
3314 } {1}
3316 test range-1.4 {basic range tests} {
3317     range 1 10 11
3318 } {1}
3320 test range-1.5 {basic range tests} {
3321     range 10 10
3322 } {}
3324 test range-1.6 {basic range tests} {
3325     range 10 10 2
3326 } {}
3328 test range-1.7 {basic range test} {
3329     range 5
3330 } {0 1 2 3 4}
3332 test range-1.8 {basic range test} {
3333     range -10 -20 -2
3334 } {-10 -12 -14 -16 -18}
3336 test range-1.9 {basic range test} {
3337     range -20 -10 3
3338 } {-20 -17 -14 -11}
3340 test range-2.0 {foreach range test} {
3341     set k 0
3342     foreach {x y} [range 100] {
3343         incr k [expr {$x*$y}]
3344     }
3345     set k
3346 } {164150}
3348 test range-2.1 {foreach range test without obj reuse} {
3349     set k 0
3350     set trash {}
3351     foreach {x y} [range 100] {
3352         incr k [expr {$x*$y}]
3353         lappend trash $x $y
3354     }
3355     set trash {}
3356     set k
3357 } {164150}
3359 test range-2.2 {range element shimmering test} {
3360     set k {}
3361     foreach x [range 0 10] {
3362         append k [llength $x]
3363     }
3364     set k
3365 } {1111111111}
3367 test range-3.0 {llength range test} {
3368     llength [range 5000]
3369 } {5000}
3371 test range-3.1 {llength range test} {
3372     llength [range 5000 5000]
3373 } {0}
3375 test range-4.0 {lindex range test} {
3376     lindex [range 1000] 500
3377 } {500}
3379 test range-4.1 {lindex range test} {
3380     lindex [range 1000] end-2
3381 } {997}
3383 test range-5.0 {lindex llength range test} {
3384     set k 0
3385     set trash {}
3386     set r [range 100]
3387     for {set i 0} {$i < [llength $r]} {incr i 2} {
3388         incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}]
3389     }
3390     set trash {}
3391     set k
3392 } {164150}
3394 ################################################################################
3395 # SCOPE
3396 ################################################################################
3397 if 0 {
3398 test scope-1.0 {Non existing var} {
3399     catch {unset x}
3400     scope x {
3401         set x 10
3402         set y [+ $x 1]
3403     }
3404     list [info exists x] $y
3405 } {0 11}
3407 test scope-1.1 {Existing var restore} {
3408     set x 100
3409     scope x {
3410         for {set x 0} {$x < 10} {incr x} {}
3411     }
3412     set x
3413 } {100}
3415 test scope-1.2 {Mix of 1.0 and 1.1 tests} {
3416     catch {unset x}
3417     set y 10
3418     scope {x y} {
3419         set y 100
3420         set x 200
3421     }
3422     list [info exists x] $y
3423 } {0 10}
3425 test scope-1.3 {Array element} {
3426     set x "a 1 b 2"
3427     scope x(a) {
3428         set x(a) Hello!
3429     }
3430     set x(a)
3431 } {1}
3433 test scope-1.4 {Non existing array element} {
3434     catch {unset x}
3435     scope x(a) {
3436         set x(a) Hello!
3437     }
3438     info exists x(a)
3439 } {0}
3441 test scope-1.5 {Info exists} {
3442     set x foo
3443     scope x {
3444         info exists x
3445     }
3446 } {0}
3448 catch {unset x}
3449 catch {unset y}
3452 ################################################################################
3453 # RAND
3454 ################################################################################
3455 test rand-1.0 {Only one output is valid} {
3456     list [rand 100 100] [rand 101 101]
3457 } {100 101}
3459 test rand-1.1 {invalid arguments} {
3460     catch {rand 100 50} err
3461     set err
3462 } {Invalid arguments (max < min)}
3464 test rand-1.2 {Check limits} {
3465     set sum 0
3466     for {set i 0} {$i < 100} {incr i} {
3467         incr sum [expr {([rand $i] >= 0)+([rand $i] < 100)}]
3468     }
3469     set sum
3470 } {200}
3472 catch {unset sum; unset err; unset i}
3474 ################################################################################
3475 # JIM REGRESSION TESTS
3476 ################################################################################
3477 test regression-1.0 {Rename against procedures with static vars} {
3478     proc foobar {x} {{y 10}} {
3479         incr y $x
3480     }
3481     foobar 30
3482     foobar 20
3483     rename foobar barfoo
3484     list [barfoo 1] [barfoo 2] [barfoo 3]
3485 } {61 63 66}
3487 catch {rename barfoo {}}
3489 test regression-1.1 {lrange bug with negative indexes of type int} {
3490     lrange {a b c} 0 [- 0 1]
3491 } {}
3493 test regression-1.2 {open/close from non-global namespace} {
3494         proc a::b {} {
3495                 set f [open $::argv0]
3496                 $f close
3497                 return $f
3498         }
3499         set f [a::b]
3500         rename a::b ""
3501         expr {$f in [info channels]}
3502 } {0}
3504 test regression-1.3 {value of tcl_platform(engine)} {
3505   set ::tcl_platform(engine)
3506 } {Jim}
3508 testreport