event.test: Fix test on Haiku
[jimtcl.git] / tests / jim.test
blobc1ab8e781418523dd436fed312a97dd5ac9344c4
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 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 catch { unset lindex}
1838 catch { unset minus }
1840 ################################################################################
1841 # LINDEX
1842 ################################################################################
1844 catch {unset a}
1845 catch {unset x}
1847 # Basic "foreach" operation.
1849 test foreach-1.1 {basic foreach tests} {
1850         set a {}
1851         foreach i {a b c d} {
1852                 set a [concat $a $i]
1853         }
1854         set a
1855 } {a b c d}
1856 test foreach-1.2 {basic foreach tests} {
1857   set a {}
1858   foreach i {a b {{c d} e} {123 {{x}}}} {
1859                 set a [concat $a $i]
1860         }
1861   set a
1862 } {a b {c d} e 123 {{x}}}
1863 test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1
1864 test foreach-1.4 {basic foreach tests} {catch {foreach i} msg} 1
1865 test foreach-1.5 {basic foreach tests} {catch {foreach i j} msg} 1
1866 test foreach-1.6 {basic foreach tests} {catch {foreach i j k l} msg} 1
1867 test foreach-1.7 {basic foreach tests} {
1868   set a {}
1869   foreach i {} {
1870                 set a [concat $a $i]
1871         }
1872   set a
1873 } {}
1874 catch {unset a}
1875 test foreach-2.1 {foreach errors} {
1876     list [catch {foreach {} {} {}} msg] $msg
1877 } {1 {foreach varlist is empty}}
1878 catch {unset a}
1880 test foreach-3.1 {parallel foreach tests} {
1881   set x {}
1882   foreach {a b} {1 2 3 4} {
1883                 append x $b $a
1884         }
1885   set x
1886 } {2143}
1887 test foreach-3.2 {parallel foreach tests} {
1888   set x {}
1889   foreach {a b} {1 2 3 4 5} {
1890                 append x $b $a
1891   }
1892         set x
1893 } {21435}
1894 test foreach-3.3 {parallel foreach tests} {
1895   set x {}
1896   foreach a {1 2 3} b {4 5 6} {
1897                 append x $b $a
1898         }
1899   set x
1900 } {415263}
1901 test foreach-3.4 {parallel foreach tests} {
1902   set x {}
1903   foreach a {1 2 3} b {4 5 6 7 8} {
1904                 append x $b $a
1905         }
1906   set x
1907 } {41526378}
1908 test foreach-3.5 {parallel foreach tests} {
1909   set x {}
1910   foreach {a b} {a b A B aa bb} c {c C cc CC} {
1911                 append x $a $b $c
1912         }
1913   set x
1914 } {abcABCaabbccCC}
1915 test foreach-3.6 {parallel foreach tests} {
1916   set x {}
1917   foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
1918                 append x $a $b $c $d $e
1919   }
1920         set x
1921 } {111112222233333}
1922 test foreach-3.7 {parallel foreach tests} {
1923   set x {}
1924   foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
1925                 append x $a $b $c $d $e
1926   }
1927         set x
1928 } {1111 2222334}
1929 test foreach-4.1 {foreach only sets vars if repeating loop} {
1930   proc foo {} {
1931                 set rgb {65535 0 0}
1932                 foreach {r g b} [set rgb] {}
1933                 return "r=$r, g=$g, b=$b"
1934         }
1935         foo
1936 } {r=65535, g=0, b=0}
1937 test foreach-5.1 {foreach supports dict syntactic sugar} {
1938         proc foo {} {
1939     set x {}
1940     foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]}
1941                 list $a $x
1942         }
1943         foo
1944 } {{3 4} {1 2 3 4}}
1946 test foreach-6.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
1947   catch {unset x}
1948   foreach {12.0} {a b c} {
1949     set x 12.0  
1950     set x [expr $x + 1]
1951   }
1952   set x
1953 } 13.0
1955 # Check "continue".
1957 test foreach-7.1 {continue tests} {catch continue} 4
1958 test foreach-7.2 {continue tests} {
1959   set a {}
1960   foreach i {a b c d} {
1961                 if {[string compare $i "b"] == 0} continue
1962                 set a [concat $a $i]
1963         }
1964    set a
1965 } {a c d}
1966 test foreach-7.3 {continue tests} {
1967         set a {}
1968   foreach i {a b c d} {
1969                 if {[string compare $i "b"] != 0} continue
1970                 set a [concat $a $i]
1971         }
1972   set a
1973 } {b}
1974 test foreach-7.4 {continue tests} {catch {continue foo} msg} 1
1975 test foreach-7.5 {continue tests} {
1976         catch {continue foo} msg
1977   set msg
1978 } {wrong # args: should be "continue"}
1980 # Check "break".
1982 test foreach-8.1 {break tests} {catch break} 3
1983 test foreach-8.2 {break tests} {
1984   set a {}
1985         foreach i {a b c d} {
1986                 if {[string compare $i "c"] == 0} break
1987                 set a [concat $a $i]
1988         }
1989   set a
1990 } {a b}
1991 test foreach-8.3 {break tests} {catch {break foo} msg} 1
1992 test foreach-8.4 {break tests} {
1993   catch {break foo} msg
1994   set msg
1995 } {wrong # args: should be "break"}
1997 # Test for incorrect "double evaluation" semantics
1999 test foreach-9.1 {delayed substitution of body - knownbugs} {
2000   proc foo {} {
2001     set a 0
2002     foreach a [list 1 2 3] "
2003       set x $a
2004     "
2005     set x
2006   }
2007   foo
2008 } {0}
2010 # cleanup
2011 catch {unset a}
2012 catch {unset x}
2014 ################################################################################
2015 # STRING
2016 ################################################################################
2018 # string last
2019 test string-7.1 {string last, too few args} {
2020     list [catch {string last a} msg] $msg
2021 } {1 {wrong # args: should be "string last subString string ?index?"}}
2022 test string-7.2 {string last, bad args} {
2023     list [catch {string last a b c} msg] $msg
2024 } {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
2025 test string-7.3 {string last, too many args} {
2026     list [catch {string last a b c d} msg] $msg
2027 } {1 {wrong # args: should be "string last subString string ?index?"}}
2028 test string-7.5 {string last} {
2029     string last xx xxxx123xx345x678
2030 } 7
2031 test string-7.13 {string last, start index} {
2032     ## Constrain to last 'a' should work
2033     string last ba badbad end-1
2034 } 3
2035 test string-7.14 {string last, start index} {
2036     ## Constrain to last 'b' should skip last 'ba'
2037     string last ba badbad end-2
2038 } 0
2040 ## string match
2042 test string-11.1 {string match, too few args} {
2043     proc foo {} {string match a}
2044     list [catch {foo} msg] $msg
2045 } {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
2046 test string-11.2 {string match, too many args} {
2047     proc foo {} {string match a b c d}
2048     list [catch {foo} msg] $msg
2049 } {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
2050 test string-11.3 {string match} {
2051     proc foo {} {string match abc abc}
2052     foo
2053 } 1
2054 #test string-11.4 {string match} {
2055 #    proc foo {} {string mat abc abd}
2056 #    foo
2057 #} 0
2058 test string-11.5 {string match} {
2059     proc foo {} {string match ab*c abc}
2060     foo
2061 } 1
2062 test string-11.6 {string match} {
2063     proc foo {} {string match ab**c abc}
2064     foo
2065 } 1
2066 test string-11.7 {string match} {
2067     proc foo {} {string match ab* abcdef}
2068     foo
2069 } 1
2070 test string-11.8 {string match} {
2071     proc foo {} {string match *c abc}
2072     foo
2073 } 1
2074 test string-11.9 {string match} {
2075     proc foo {} {string match *3*6*9 0123456789}
2076     foo
2077 } 1
2078 test string-11.10 {string match} {
2079     proc foo {} {string match *3*6*9 01234567890}
2080     foo
2081 } 0
2082 test string-11.11 {string match} {
2083     proc foo {} {string match a?c abc}
2084     foo
2085 } 1
2086 test string-11.12 {string match} {
2087     proc foo {} {string match a??c abc}
2088     foo
2089 } 0
2090 test string-11.13 {string match} {
2091     proc foo {} {string match ?1??4???8? 0123456789}
2092     foo
2093 } 1
2094 test string-11.14 {string match} {
2095     proc foo {} {string match {[abc]bc} abc}
2096     foo
2097 } 1
2098 test string-11.15 {string match} {
2099     proc foo {} {string match {a[abc]c} abc}
2100     foo
2101 } 1
2102 test string-11.16 {string match} {
2103     proc foo {} {string match {a[xyz]c} abc}
2104     foo
2105 } 0
2106 test string-11.17 {string match} {
2107     proc foo {} {string match {12[2-7]45} 12345}
2108     foo
2109 } 1
2110 test string-11.18 {string match} {
2111     proc foo {} {string match {12[ab2-4cd]45} 12345}
2112     foo
2113 } 1
2114 test string-11.19 {string match} {
2115     proc foo {} {string match {12[ab2-4cd]45} 12b45}
2116     foo
2117 } 1
2118 test string-11.20 {string match} {
2119     proc foo {} {string match {12[ab2-4cd]45} 12d45}
2120     foo
2121 } 1
2122 test string-11.21 {string match} {
2123     proc foo {} {string match {12[ab2-4cd]45} 12145}
2124     foo
2125 } 0
2126 test string-11.22 {string match} {
2127     proc foo {} {string match {12[ab2-4cd]45} 12545}
2128     foo
2129 } 0
2130 test string-11.23 {string match} {
2131     proc foo {} {string match {a\*b} a*b}
2132     foo
2133 } 1
2134 test string-11.24 {string match} {
2135     proc foo {} {string match {a\*b} ab}
2136     foo
2137 } 0
2138 test string-11.25 {string match} {
2139     proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
2140     foo
2141 } 1
2142 test string-11.26 {string match} {
2143     proc foo {} {string match ** ""}
2144     foo
2145 } 1
2146 test string-11.27 {string match} {
2147     proc foo {} {string match *. ""}
2148     foo
2149 } 0
2150 test string-11.28 {string match} {
2151     proc foo {} {string match "" ""}
2152     foo
2153 } 1
2154 test string-11.29 {string match} {
2155     proc foo {} {string match \[a a}
2156     foo
2157 } 1
2158 test string-11.31 {string match case} {
2159     proc foo {} {string match a A}
2160     foo
2161 } 0
2162 test string-11.32 {string match nocase} {
2163     proc foo {} {string match -n a A}
2164     foo
2165 } 1
2166 #test string-11.33 {string match nocase} {
2167 #    proc foo {} {string match -nocase a\334 A\374}
2168 #    foo
2169 #} 1
2170 test string-11.34 {string match nocase} {
2171     proc foo {} {string match -nocase a*f ABCDEf}
2172     foo
2173 } 1
2174 test string-11.35 {string match case, false hope} {
2175     # This is true because '_' lies between the A-Z and a-z ranges
2176     proc foo {} {string match {[A-z]} _}
2177     foo
2178 } 1
2179 test string-11.36 {string match nocase range} {
2180     # This is false because although '_' lies between the A-Z and a-z ranges,
2181     # we lower case the end points before checking the ranges.
2182     proc foo {} {string match -nocase {[A-z]} _}
2183     foo
2184 } 0
2185 test string-11.37 {string match nocase} {
2186     proc foo {} {string match -nocase {[A-fh-Z]} g}
2187     foo
2188 } 0
2189 test string-11.38 {string match case, reverse range} {
2190     proc foo {} {string match {[A-fh-Z]} g}
2191     foo
2192 } 1
2193 test string-11.39 {string match, *\ case} {
2194     proc foo {} {string match {*\abc} abc}
2195     foo
2196 } 1
2197 test string-11.40 {string match, *special case} {
2198     proc foo {} {string match {*[ab]} abc}
2199     foo
2200 } 0
2201 test string-11.41 {string match, *special case} {
2202     proc foo {} {string match {*[ab]*} abc}
2203     foo
2204 } 1
2205 #test string-11.42 {string match, *special case} {
2206 #    proc foo {} {string match "*\\" "\\"}
2207 #    foo
2208 #} 0
2209 test string-11.43 {string match, *special case} {
2210     proc foo {} {string match "*\\\\" "\\"}
2211     foo
2212 } 1
2213 test string-11.44 {string match, *special case} {
2214     proc foo {} {string match "*???" "12345"}
2215     foo
2216 } 1
2217 test string-11.45 {string match, *special case} {
2218     proc foo {} {string match "*???" "12"}
2219     foo
2220 } 0
2221 test string-11.46 {string match, *special case} {
2222     proc foo {} {string match "*\\*" "abc*"}
2223     foo
2224 } 1
2225 test string-11.47 {string match, *special case} {
2226     proc foo {} {string match "*\\*" "*"}
2227     foo
2228 } 1
2229 test string-11.48 {string match, *special case} {
2230     proc foo {} {string match "*\\*" "*abc"}
2231     foo
2232 } 0
2233 test string-11.49 {string match, *special case} {
2234     proc foo {} {string match "?\\*" "a*"}
2235     foo
2236 } 1
2237 #test string-11.50 {string match, *special case} {
2238 #    proc foo {} {string match "\\" "\\"}
2239 #    foo
2240 #} 0
2242 ## string length
2244 test string-9.1 {string length} {
2245     proc foo {} {string length}
2246     list [catch {foo} msg] $msg
2247 } {1 {wrong # args: should be "string length string"}}
2248 test string-9.2 {string length} {
2249     proc foo {} {string length a b}
2250     list [catch {foo} msg] $msg
2251 } {1 {wrong # args: should be "string length string"}}
2252 test string-9.3 {string length} {
2253     proc foo {} {string length "a little string"}
2254     foo
2255 } 15
2257 # string map
2259 test string-10.4 {string map} {
2260     string map {a b} abba
2261 } {bbbb}
2262 test string-10.5 {string map} {
2263     string map {a b} a
2264 } {b}
2265 test string-10.6 {string map -nocase} {
2266     string map -nocase {a b} Abba
2267 } {bbbb}
2268 test string-10.7 {string map} {
2269     string map {abc 321 ab * a A} aabcabaababcab
2270 } {A321*A*321*}
2271 test string-10.8 {string map -nocase} {
2272     string map -nocase {aBc 321 Ab * a A} aabcabaababcab
2273 } {A321*A*321*}
2274 test string-10.10 {string map} {
2275     list [catch {string map {a b c} abba} msg] $msg
2276 } {1 {list must contain an even number of elements}}
2277 test string-10.11 {string map, nulls} {
2278     string map {\x00 NULL blah \x00nix} {qwerty}
2279 } {qwerty}
2280 test string-10.12 {string map, unicode} {
2281     string map [list \u00fc ue UE \u00dc] "a\u00fcueUE\000EU"
2282 } aueue\u00dc\0EU
2283 test string-10.13 {string map, -nocase unicode} {
2284     string map -nocase [list \u00fc ue UE \u00dc] "a\u00fcueUE\000EU"
2285 } aue\u00dc\u00dc\0EU
2286 test string-10.14 {string map, -nocase null arguments} {
2287     string map -nocase {{} abc} foo
2288 } foo
2289 test string-10.15 {string map, one pair case} {
2290     string map -nocase {abc 32} aAbCaBaAbAbcAb
2291 } {a32aBaAb32Ab}
2292 test string-10.16 {string map, one pair case} {
2293     string map -nocase {ab 4321} aAbCaBaAbAbcAb
2294 } {a4321C4321a43214321c4321}
2295 test string-10.17 {string map, one pair case} {
2296     string map {Ab 4321} aAbCaBaAbAbcAb
2297 } {a4321CaBa43214321c4321}
2298 test string-10.18 {string map, empty argument} {
2299     string map -nocase {{} abc} foo
2300 } foo
2301 test string-10.19 {string map, empty arguments} {
2302     string map -nocase {{} abc f bar {} def} foo
2303 } baroo
2305 ################################################################################
2306 # SPLIT
2307 ################################################################################
2309 test split-1.1 {basic split commands} {
2310     split "a\n b\t\r c\n "
2311 } {a {} b {} {} c {} {}}
2312 test split-1.2 {basic split commands} {
2313     split "word 1xyzword 2zword 3" xyz
2314 } {{word 1} {} {} {word 2} {word 3}}
2315 test split-1.3 {basic split commands} {
2316     split "12345" {}
2317 } {1 2 3 4 5}
2318 test split-1.4 {basic split commands} {
2319     split "a\}b\[c\{\]\$"
2320 } "a\\}b\\\[c\\{\\\]\\\$"
2321 test split-1.5 {basic split commands} {
2322     split {} {}
2323 } {}
2324 test split-1.6 {basic split commands} {
2325     split {}
2326 } {}
2327 test split-1.7 {basic split commands} {
2328     split {   }
2329 } {{} {} {} {}}
2330 test split-1.8 {basic split commands} {
2331     proc foo {} {
2332         set x {}
2333         foreach f [split {]\n} {}] {
2334             append x $f
2335         }
2336         return $x       
2337     }
2338     foo
2339 } {]\n}
2340 test split-1.9 {basic split commands} {
2341     proc foo {} {
2342         set x ab\000c
2343         set y [split $x {}]
2344         return $y
2345     }
2346     foo
2347 } "a b \000 c"
2348 test split-1.10 {basic split commands} {
2349     split "a0ab1b2bbb3\000c4" ab\000c
2350 } {{} 0 {} 1 2 {} {} 3 {} 4}
2351 test split-1.11 {basic split commands} {
2352     split "12,3,45" {,}
2353 } {12 3 45}
2354 test split-1.12 {basic split commands} {
2355     split "\u0001ab\u0001cd\u0001\u0001ef\u0001" \1
2356 } {{} ab cd {} ef {}}
2357 test split-1.13 {basic split commands} {
2358     split "12,34,56," {,}
2359 } {12 34 56 {}}
2360 test split-1.14 {basic split commands} {
2361     split ",12,,,34,56," {,}
2362 } {{} 12 {} {} 34 56 {}}
2364 test split-2.1 {split errors} {
2365     list [catch split msg] $msg
2366 } {1 {wrong # args: should be "split string ?splitChars?"}}
2367 test split-2.2 {split errors} {
2368     list [catch {split a b c} msg] $msg
2369 } {1 {wrong # args: should be "split string ?splitChars?"}}
2371 # cleanup
2372 catch {rename foo {}}
2374 ################################################################################
2375 # JOIN
2376 ################################################################################
2378 test join-1.1 {basic join commands} {
2379     join {a b c} xyz
2380 } axyzbxyzc
2381 test join-1.2 {basic join commands} {
2382     join {a b c} {}
2383 } abc
2384 test join-1.3 {basic join commands} {
2385     join {} xyz
2386 } {}
2387 test join-1.4 {basic join commands} {
2388     join {12 34 56}
2389 } {12 34 56}
2391 test join-2.1 {join errors} {
2392     list [catch join msg] $msg
2393 } {1 {wrong # args: should be "join list ?joinString?"}}
2394 test join-2.2 {join errors} {
2395     list [catch {join a b c} msg] $msg
2396 } {1 {wrong # args: should be "join list ?joinString?"}}
2397 #test join-2.3 {join errors} {
2398 #    list [catch {join "a \{ c" 111} msg] $msg
2399 #} {1 {unmatched open brace in list}}
2401 test join-3.1 {joinString is binary ok} {
2402   string length [join {a b c} a\0b]
2403 } 9
2405 test join-3.2 {join is binary ok} {
2406   string length [join "a\0b a\0b a\0b"]
2407 } 11
2409 ################################################################################
2410 # SWITCH
2411 ################################################################################
2413 test switch-1.1 {simple patterns} {
2414     switch a a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2415 } 1
2416 test switch-1.2 {simple patterns} {
2417     switch b a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2418 } 2
2419 test switch-1.3 {simple patterns} {
2420     switch x a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2421 } 4
2422 test switch-1.4 {simple patterns} {
2423     switch x a {expr 1} b {expr 2} c {expr 3}
2424 } {}
2425 test switch-1.5 {simple pattern matches many times} {
2426     switch b a {expr 1} b {expr 2} b {expr 3} b {expr 4}
2427 } 2
2428 test switch-1.6 {simple patterns} {
2429     switch default a {expr 1} default {expr 2} c {expr 3} default {expr 4}
2430 } 2
2431 test switch-1.7 {simple patterns} {
2432     switch x a {expr 1} default {expr 2} c {expr 3} default {expr 4}
2433 } 4
2435 test switch-2.1 {single-argument form for pattern/command pairs} {
2436     switch b {
2437         a {expr 1}
2438         b {expr 2}
2439         default {expr 6}
2440     }
2441 } {2}
2442 test switch-2.2 {single-argument form for pattern/command pairs} {
2443     list [catch {switch z {a 2 b}}]
2444 } 1
2446 test switch-3.1 {-exact vs. -glob vs. -regexp} {
2447     switch -exact aaaab {
2448         ^a*b$   {concat regexp}
2449         *b      {concat glob}
2450         aaaab   {concat exact}
2451         default {concat none}
2452     }
2453 } exact
2454 test switch-3.2 {-exact vs. -glob vs. -regexp (no [regexp] cmd)} regexp {
2455         rename regexp regexp.none
2456     set rc [catch {
2457         switch -regexp aaaab {
2458         ^a*b$   {concat regexp}
2459         *b      {concat glob}
2460         aaaab   {concat exact}
2461         default {concat none}
2462         }
2463     }]
2464         rename regexp.none regexp
2465         set rc
2466 } 1
2468 test switch-3.3 {-exact vs. -glob vs. -regexp (with [regexp] cmd)} regexp {
2469     switch -regexp aaaab {
2470         ^a*b$   {concat regexp}
2471         *b          {concat glob}
2472         aaaab   {concat exact}
2473         default {concat none}
2474     }
2475 } regexp
2476 test switch-3.4 {-exact vs. -glob vs. -regexp} {
2477     switch -glob aaaab {
2478         ^a*b$   {concat regexp}
2479         *b          {concat glob}
2480         aaaab   {concat exact}
2481         default {concat none}
2482     }
2483 } glob
2484 test switch-3.5 {-exact vs. -glob vs. -regexp} {
2485     switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
2486             aaaab {concat exact} default {concat none}
2487 } exact
2488 test switch-3.6 {-exact vs. -glob vs. -regexp} {
2489     switch -- -glob {
2490         ^g.*b$  {concat regexp}
2491         -*      {concat glob}
2492         -glob   {concat exact}
2493         default {concat none}
2494     }
2495 } exact
2496 test switch-3.7 {-exact vs. -glob vs. -regexp} {
2497     list [catch {switch -foo a b c} msg] $msg
2498 } {1 {bad option "-foo": must be -exact, -glob, -regexp, -command procname or --}}
2500 test switch-4.1 {error in executed command} {
2501     list [catch {switch a a {error "Just a test"} default {expr 1}} msg] \
2502             $msg
2503 } {1 {Just a test}}
2504 test switch-4.2 {error: not enough args} {
2505     catch {switch}
2506 } 1
2507 test switch-4.3 {error: pattern with no body} {
2508     catch {switch a b}
2509 } 1
2510 test switch-4.4 {error: pattern with no body} {
2511     catch {switch a b {expr 1} c}
2512 } 1
2513 test switch-4.5 {error in default command} {
2514     list [catch {switch foo a {error switch1} b {error switch 3} \
2515             default {error switch2}} msg] $msg
2516 } {1 switch2}
2518 test switch-5.1 {errors in -regexp matching} regexp {
2519     catch {switch -regexp aaaab {
2520         *b      {concat glob}
2521         aaaab   {concat exact}
2522         default {concat none}
2523     }} msg
2524 } 1
2526 test switch-6.1 {backslashes in patterns} {
2527     switch -exact {\a\$\.\[} {
2528         \a\$\.\[        {concat first}
2529         \a\\$\.\\[      {concat second}
2530         \\a\\$\\.\\[    {concat third}
2531         {\a\\$\.\\[}    {concat fourth}
2532         {\\a\\$\\.\\[}  {concat fifth}
2533         default         {concat none}
2534     }
2535 } third
2536 test switch-6.2 {backslashes in patterns} {
2537     switch -exact {\a\$\.\[} {
2538         \a\$\.\[        {concat first}
2539         {\a\$\.\[}      {concat second}
2540         {{\a\$\.\[}}    {concat third}
2541         default         {concat none}
2542     }
2543 } second
2545 test switch-7.1 {"-" bodies} {
2546     switch a {
2547         a -
2548         b -
2549         c {concat 1}
2550         default {concat 2}
2551     }
2552 } 1
2553 test switch-7.2 {"-" bodies} {
2554     list [catch {
2555         switch a {
2556             a -
2557             b -
2558             c -
2559         }
2560     } msg] $msg
2561 } {1 {no body specified for pattern "c"}}
2562 # Following original Tcl test makes no sense, I feel! Please review ...
2563 #~ test switch-7.3 {"-" bodies} {
2564     #~ list [catch {
2565         #~ switch a {
2566             #~ a -
2567             #~ b -foo
2568             #~ c -
2569         #~ }
2570     #~ } msg] $msg
2571 #~ } {1 {no body specified for pattern "c"}}
2572 test switch-7.3 {"-" bodies} {
2573     list [catch {
2574         switch a {
2575             a -
2576             b -foo
2577             c -
2578         }
2579     } msg] $msg
2580 } {1 {invalid command name "-foo"}}
2582 test switch-8.1 {empty body} {
2583     set msg {}
2584     switch {2} {
2585         1 {set msg 1}
2586         2 {}
2587         default {set msg 2}
2588     }
2589 } {}
2591 test switch-9.1 {empty pattern/body list} {
2592     catch {switch x}
2593 } 1
2594 test switch-9.2 {empty pattern/body list} {
2595     catch {switch -- x} 
2596 } 1 
2597 test switch-9.3 {empty pattern/body list} {
2598     catch {switch x {}} 
2599 } 1
2600 test switch-9.4 {empty pattern/body list} {
2601     catch {switch -- x {}}
2602 } 1
2603 test switch-9.5 {unpaired pattern} {
2604     catch {switch x a {} b}
2605 } 1
2606 test switch-9.6 {unpaired pattern} {
2607     catch {switch x {a {} b}}
2608 } 1
2609 test switch-9.7 {unpaired pattern} {
2610     catch {switch x a {} # comment b}
2611 } 1
2612 test switch-9.8 {unpaired pattern} {
2613     catch {switch x {a {} # comment b}}
2614 } 1
2615 test switch-9.9 {unpaired pattern} {
2616     catch {switch x a {} x {} # comment b}
2617 } 1
2618 test switch-9.10 {unpaired pattern} {
2619     catch {switch x {a {} x {} # comment b}}
2620 } 1
2622 test switch-10.1 {no callback given to -command} {
2623     catch {switch -command a { a {expr 1} b {expr 2} }} 
2624 } 1
2625 test switch-10.2 {callback expect wrong # args for -command} lambda {
2626     catch {switch -command [lambda {p1} {expr 1}] a { a {expr 1} b {expr 2} }}
2627 } 1
2628 test switch-10.3 {callback to -command returns ever 0: no match} lambda {
2629     switch -command [lambda {p1 p2} {expr 0}] a a {expr 1} b {expr 2}
2630 } {}
2631 test switch-10.4 {callback to -command returns 3 at first match} lambda {
2632     switch -command [lambda {p1 p2} {expr 3}] a a {expr 1} b {expr 2}
2633 } 1
2634 test switch-10.5 {[error] in callback to -command} lambda {
2635     list [catch {
2636         switch -command [lambda {p1 p2} {error "foo"}] a a {expr 1} b {expr 2}
2637     } msg] $msg
2638 } {1 foo}
2639 test switch-10.6 {[continue] in callback to -command} lambda {
2640     list [catch {
2641         switch -command [lambda {p1 p2} {continue}] a a {expr 1} b {expr 2}
2642     } msg] $msg
2643 } {4 {}}
2644 test switch-10.7 {callback matches first if pat < str} lambda {
2645     switch -command [lambda {pat str} {expr {$pat < $str}}] 3 \
2646         5 {expr 1} 3 {expr 2}
2647 } {}
2648 test switch-10.8 {callback matches first if pat < str} lambda {
2649     switch -command [lambda {pat str} {expr {$pat < $str}}] 7 \
2650         5 {expr 1} 3 {expr 2}
2651 } 1
2652 test switch-10.9 {callback matches first if pat < str} lambda {
2653     switch -command [lambda {pat str} {expr {$pat < $str}}] 4 \
2654         5 {expr 1} 3 {expr 2}
2655 } 2
2657 ################################################################################
2658 # FOR
2659 ################################################################################
2661 # Basic "for" operation.
2662 test for-1.1 {TclCompileForCmd: missing initial command} {
2663     list [catch {for} msg] $msg
2664 } {1 {wrong # args: should be "for start test next body"}}
2665 test for-1.2 {TclCompileForCmd: error in initial command} {
2666     list [catch {for {set}} msg] $msg
2667 } {1 {wrong # args: should be "for start test next body"}}
2668 catch {unset i}
2669 test for-1.3 {TclCompileForCmd: missing test expression} {
2670     catch {for {set i 0}} msg
2671     set msg
2672 } {wrong # args: should be "for start test next body"}
2673 test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
2674     set i 0
2675     for {} "$i > 5" {incr i} {}
2676 } {}
2677 test for-1.6 {TclCompileForCmd: missing "next" command} {
2678     catch {for {set i 0} {$i < 5}} msg
2679     set msg
2680 } {wrong # args: should be "for start test next body"}
2681 test for-1.7 {TclCompileForCmd: missing command body} {
2682     catch {for {set i 0} {$i < 5} {incr i}} msg
2683     set msg
2684 } {wrong # args: should be "for start test next body"}
2685 catch {unset a}
2686 test for-1.9 {TclCompileForCmd: simple command body} {
2687     set a {}
2688     for {set i 1} {$i<6} {set i [expr $i+1]} {
2689         if $i==4 break
2690         set a [concat $a $i]
2691     }
2692     set a
2693 } {1 2 3}
2694 test for-1.10 {TclCompileForCmd: command body in quotes} {
2695     set a {}
2696     for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2697     set a
2698 } {xxxxx}
2699 test for-1.11 {TclCompileForCmd: computed command body} {
2700     catch {unset x1}
2701     catch {unset bb}
2702     catch {unset x2}
2703     set x1 {append a x1; }
2704     set bb {break}
2705     set x2 {; append a x2}
2706     set a {}
2707     for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
2708     set a
2709 } {x1}
2710 test for-1.13 {TclCompileForCmd: long command body} {
2711     set a {}
2712     for {set i 1} {$i<6} {set i [expr $i+1]} {
2713         if $i==4 break
2714         if $i>5 continue
2715         set tcl_platform(machine) i686
2716         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2717             catch {set a $a} msg
2718             catch {incr i 5} msg
2719             catch {incr i -5} msg
2720         }
2721         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2722             catch {set a $a} msg
2723             catch {incr i 5} msg
2724             catch {incr i -5} msg
2725         }
2726         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2727             catch {set a $a} msg
2728             catch {incr i 5} msg
2729             catch {incr i -5} msg
2730         }
2731         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2732             catch {set a $a} msg
2733             catch {incr i 5} msg
2734             catch {incr i -5} msg
2735         }
2736         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2737             catch {set a $a} msg
2738             catch {incr i 5} msg
2739             catch {incr i -5} msg
2740         }
2741         set a [concat $a $i]
2742     }
2743     set a
2744 } {1 2 3}
2745 test for-1.14 {TclCompileForCmd: for command result} {
2746     set a [for {set i 0} {$i < 5} {incr i} {}]
2747     set a
2748 } {}
2749 test for-1.15 {TclCompileForCmd: for command result} {
2750     set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
2751     set a
2752 } {}
2754 # Check "for" and "continue".
2756 test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
2757     catch {continue foo} msg
2758     set msg
2759 } {wrong # args: should be "continue"}
2760 test for-2.2 {TclCompileContinueCmd: continue result} {
2761     catch continue
2762 } 4
2763 test for-2.3 {continue tests} {
2764     set a {}
2765     for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2766         if {$i == 2} continue
2767         set a [concat $a $i]
2768     }
2769     set a
2770 } {1 3 4}
2771 test for-2.4 {continue tests} {
2772     set a {}
2773     for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2774         if {$i != 2} continue
2775         set a [concat $a $i]
2776     }
2777     set a
2778 } {2}
2779 test for-2.5 {continue tests, nested loops} {
2780     set msg {}
2781     for {set i 1} {$i <= 4} {incr i} {
2782         for {set a 1} {$a <= 2} {incr a} {
2783             if {$i>=2 && $a>=2} continue
2784             set msg [concat $msg "$i.$a"]
2785         }
2786     }
2787     set msg
2788 } {1.1 1.2 2.1 3.1 4.1}
2789 test for-2.6 {continue tests, long command body} {
2790     set a {}
2791     for {set i 1} {$i<6} {set i [expr $i+1]} {
2792         if $i==2 continue
2793         if $i==4 break
2794         if $i>5 continue
2795         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2796             catch {set a $a} msg
2797             catch {incr i 5} msg
2798             catch {incr i -5} msg
2799         }
2800         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2801             catch {set a $a} msg
2802             catch {incr i 5} msg
2803             catch {incr i -5} msg
2804         }
2805         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2806             catch {set a $a} msg
2807             catch {incr i 5} msg
2808             catch {incr i -5} msg
2809         }
2810         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2811             catch {set a $a} msg
2812             catch {incr i 5} msg
2813             catch {incr i -5} msg
2814         }
2815         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2816             catch {set a $a} msg
2817             catch {incr i 5} msg
2818             catch {incr i -5} msg
2819         }
2820         set a [concat $a $i]
2821     }
2822     set a
2823 } {1 3}
2825 # Check "for" and "break".
2827 test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
2828     catch {break foo} msg
2829     set msg
2830 } {wrong # args: should be "break"}
2831 test for-3.2 {TclCompileBreakCmd: break result} {
2832     catch break
2833 } 3
2834 test for-3.3 {break tests} {
2835     set a {}
2836     for {set i 1} {$i <= 4} {incr i} {
2837         if {$i == 3} break
2838         set a [concat $a $i]
2839     }
2840     set a
2841 } {1 2}
2842 test for-3.4 {break tests, nested loops} {
2843     set msg {}
2844     for {set i 1} {$i <= 4} {incr i} {
2845         for {set a 1} {$a <= 2} {incr a} {
2846             if {$i>=2 && $a>=2} break
2847             set msg [concat $msg "$i.$a"]
2848         }
2849     }
2850     set msg
2851 } {1.1 1.2 2.1 3.1 4.1}
2852 test for-3.5 {break tests, long command body} {
2853     set a {}
2854     for {set i 1} {$i<6} {set i [expr $i+1]} {
2855         if $i==2 continue
2856         if $i==5 break
2857         if $i>5 continue
2858         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2859             catch {set a $a} msg
2860             catch {incr i 5} msg
2861             catch {incr i -5} msg
2862         }
2863         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2864             catch {set a $a} msg
2865             catch {incr i 5} msg
2866             catch {incr i -5} msg
2867         }
2868         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2869             catch {set a $a} msg
2870             catch {incr i 5} msg
2871             catch {incr i -5} msg
2872         }
2873         if {$i == 4} break
2874         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2875             catch {set a $a} msg
2876             catch {incr i 5} msg
2877             catch {incr i -5} msg
2878         }
2879         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2880             catch {set a $a} msg
2881             catch {incr i 5} msg
2882             catch {incr i -5} msg
2883         }
2884         set a [concat $a $i]
2885     }
2886     set a
2887 } {1 3}
2888 test for-4.1 {break must reset the interp result} {
2889     catch {
2890         set z GLOBTESTDIR/dir2/file2.c
2891         if [string match GLOBTESTDIR/dir2/* $z] {
2892             break
2893         }
2894     } j
2895     set j
2896 } {}
2898 # Test for incorrect "double evaluation" semantics
2900 test for-5.1 {possible delayed substitution of increment command} {
2901     # Increment should be 5, and lappend should always append $a
2902     catch {unset a}
2903     catch {unset i}
2904     set a 5
2905     set i {}
2906     for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2907     set i
2908 } {1 6 11}
2910 test for-5.2 {possible delayed substitution of increment command} {
2911     # Increment should be 5, and lappend should always append $a
2912     catch {rename p ""}
2913     proc p {} {
2914         set a 5
2915         set i {}
2916         for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2917         set i
2918     }
2919     p
2920 } {1 6 11}
2921 test for-5.3 {possible delayed substitution of body command} {
2922     # Increment should be $a, and lappend should always append 5
2923     set a 5
2924     set i {}
2925     for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2926     set i
2927 } {5 5 5 5}
2928 test for-5.4 {possible delayed substitution of body command} {
2929     # Increment should be $a, and lappend should always append 5
2930     catch {rename p ""}
2931     proc p {} {
2932         set a 5
2933         set i {}
2934         for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2935         set i
2936     }
2937     p
2938 } {5 5 5 5}
2940 # In the following tests we need to bypass the bytecode compiler by
2941 # substituting the command from a variable.  This ensures that command
2942 # procedure is invoked directly.
2944 test for-6.1 {Tcl_ForObjCmd: number of args} {
2945     set z for
2946     catch {$z} msg
2947     set msg
2948 } {wrong # args: should be "for start test next body"}
2949 test for-6.2 {Tcl_ForObjCmd: number of args} {
2950     set z for
2951     catch {$z {set i 0}} msg
2952     set msg
2953 } {wrong # args: should be "for start test next body"}
2954 test for-6.3 {Tcl_ForObjCmd: number of args} {
2955     set z for
2956     catch {$z {set i 0} {$i < 5}} msg
2957     set msg
2958 } {wrong # args: should be "for start test next body"}
2959 test for-6.4 {Tcl_ForObjCmd: number of args} {
2960     set z for
2961     catch {$z {set i 0} {$i < 5} {incr i}} msg
2962     set msg
2963 } {wrong # args: should be "for start test next body"}
2964 test for-6.5 {Tcl_ForObjCmd: number of args} {
2965     set z for
2966     catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
2967     set msg
2968 } {wrong # args: should be "for start test next body"}
2969 test for-6.6 {Tcl_ForObjCmd: error in initial command} {
2970     set z for
2971     list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg
2972 } {1 {wrong # args: should be "set varName ?newValue?"}}
2973 test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
2974     set z for
2975     set i 0
2976     $z {set i 6} "$i > 5" {incr i} {set y $i}
2977     set i
2978 } 6
2979 test for-6.10 {Tcl_ForObjCmd: simple command body} {
2980     set z for
2981     set a {}
2982     $z {set i 1} {$i<6} {set i [expr $i+1]} {
2983         if $i==4 break
2984         set a [concat $a $i]
2985     }
2986     set a
2987 } {1 2 3}
2988 test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
2989     set z for
2990     set a {}
2991     $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2992     set a
2993 } {xxxxx}
2994 test for-6.12 {Tcl_ForObjCmd: computed command body} {
2995     set z for
2996     catch {unset x1}
2997     catch {unset bb}
2998     catch {unset x2}
2999     set x1 {append a x1; }
3000     set bb {break}
3001     set x2 {; append a x2}
3002     set a {}
3003     $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
3004     set a
3005 } {x1}
3006 test for-6.14 {Tcl_ForObjCmd: long command body} {
3007     set z for
3008     set a {}
3009     $z {set i 1} {$i<6} {set i [expr $i+1]} {
3010         if $i==4 break
3011         if $i>5 continue
3012         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3013             catch {set a $a} msg
3014             catch {incr i 5} msg
3015             catch {incr i -5} msg
3016         }
3017         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3018             catch {set a $a} msg
3019             catch {incr i 5} msg
3020             catch {incr i -5} msg
3021         }
3022         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3023             catch {set a $a} msg
3024             catch {incr i 5} msg
3025             catch {incr i -5} msg
3026         }
3027         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3028             catch {set a $a} msg
3029             catch {incr i 5} msg
3030             catch {incr i -5} msg
3031         }
3032         if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3033             catch {set a $a} msg
3034             catch {incr i 5} msg
3035             catch {incr i -5} msg
3036         }
3037         set a [concat $a $i]
3038     }
3039     set a
3040 } {1 2 3}
3041 test for-6.15 {Tcl_ForObjCmd: for command result} {
3042     set z for
3043     set a [$z {set i 0} {$i < 5} {incr i} {}]
3044     set a
3045 } {}
3046 test for-6.16 {Tcl_ForObjCmd: for command result} {
3047     set z for
3048     set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
3049     set a
3050 } {}
3053 ################################################################################
3054 # INFO
3055 ################################################################################
3057 test info-1.1 {info body option} {
3058     proc t1 {} {body of t1}
3059     info body t1
3060 } {body of t1}
3061 test info-1.2 {info body option} {
3062     list [catch {info body set} msg] $msg
3063 } {1 {command "set" is not a procedure}}
3064 test info-1.3 {info body option} {
3065     list [catch {info args set 1} msg] $msg
3066 } {1 {wrong # args: should be "info args procname"}}
3067 test info-1.5 {info body option, returning bytecompiled bodies} {
3068     catch {unset args}
3069     proc foo {args} {
3070         foreach v $args {
3071             upvar $v var
3072             return "variable $v existence: [info exists var]"
3073         }
3074     }
3075     foo a
3076     list [catch [info body foo] msg] $msg
3077 } {1 {can't read "args": no such variable}}
3078 test info-1.6 {info body option, returning list bodies} {
3079     proc foo args [list subst bar]
3080     list [string length [info body foo]] \
3081             [foo; string length [info body foo]]
3082 } {9 9}
3083 test info-2.1 {info commands option} {
3084     proc t1 {} {}
3085     proc t2 {} {}
3086     set x " [info commands] "
3087     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
3088             [string match {* set *} $x] [string match {* list *} $x]
3089 } {1 1 1 1}
3090 test info-2.2 {info commands option} {
3091     proc t1 {} {}
3092     rename t1 {}
3093     set x [info commands]
3094     string match {* t1 *} $x
3095 } 0
3096 test info-2.3 {info commands option} {
3097     proc _test1_ {} {}
3098     proc _test2_ {} {}
3099     info commands _test1_
3100 } _test1_
3101 test info-2.4 {info commands option} {
3102     proc _test1_ {} {}
3103     proc _test2_ {} {}
3104     lsort [info commands _test*]
3105 } {_test1_ _test2_}
3106 catch {rename _test1_ {}}
3107 catch {rename _test2_ {}}
3108 test info-2.5 {info commands option} {
3109     list [catch {info commands a b} msg] $msg
3110 } {1 {wrong # args: should be "info commands ?pattern?"}}
3111 test info-3.1 {info exists option} {
3112     set value foo
3113     info exists value
3114 } 1
3115 catch {unset _nonexistent_}
3116 test info-3.2 {info exists option} {
3117     info exists _nonexistent_
3118 } 0
3119 test info-3.3 {info exists option} {
3120     proc t1 {x} {return [info exists x]}
3121     t1 2
3122 } 1
3123 test info-3.4 {info exists option} {
3124     proc t1 {x} {
3125         global _nonexistent_
3126         return [info exists _nonexistent_]
3127     }
3128     t1 2
3129 } 0
3130 test info-3.5 {info exists option} {
3131     proc t1 {x} {
3132         set y 47
3133         return [info exists y]
3134     }
3135     t1 2
3136 } 1
3137 test info-3.6 {info exists option} {
3138     proc t1 {x} {return [info exists value]}
3139     t1 2
3140 } 0
3141 test info-3.7 {info exists option} {
3142     catch {unset x}
3143     set x(2) 44
3144     list [info exists x] [info exists x(1)] [info exists x(2)]
3145 } {1 0 1}
3146 catch {unset x}
3147 test info-3.8 {info exists option} {
3148     list [catch {info exists} msg] $msg
3149 } {1 {wrong # args: should be "info exists varName"}}
3150 test info-3.9 {info exists option} {
3151     list [catch {info exists 1 2} msg] $msg
3152 } {1 {wrong # args: should be "info exists varName"}}
3153 test info-4.1 {info globals option} {
3154     set x 1
3155     set y 2
3156     set value 23
3157     set a " [info globals] "
3158     list [string match {* x *} $a] [string match {* y *} $a] \
3159             [string match {* value *} $a] [string match {* _foobar_ *} $a]
3160 } {1 1 1 0}
3161 test info-4.2 {info globals option} {
3162     set _xxx1 1
3163     set _xxx2 2
3164     lsort [info globals _xxx*]
3165 } {_xxx1 _xxx2}
3166 test info-4.3 {info globals option} {
3167     list [catch {info globals 1 2} msg] $msg
3168 } {1 {wrong # args: should be "info globals ?pattern?"}}
3169 test info-5.1 {info level option} {
3170     info level
3171 } 0
3173 test info-5.2 {info level option} {
3174     proc t1 {a b} {
3175         set x [info level]
3176         set y [info level 1]
3177         list $x $y
3178     }
3179     t1 146 testString
3180 } {1 {t1 146 testString}}
3181 test info-5.3 {info level option} {
3182     proc t1 {a b} {
3183         t2 [expr $a*2] $b
3184     }
3185     proc t2 {x y} {
3186         list [info level] [info level 1] [info level 2] [info level -1] \
3187                 [info level 0]
3188     }
3189     t1 146 {a {b c} {{{c}}}}
3190 } {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}}}}}}
3191 test info-5.4 {info level option} {
3192     proc t1 {} {
3193         set x [info level]
3194         set y [info level 1]
3195         list $x $y
3196     }
3197     t1
3198 } {1 t1}
3199 test info-5.5 {info level option} {
3200     list [catch {info level 1 2} msg] $msg
3201 } {1 {wrong # args: should be "info level ?levelNum?"}}
3202 test info-5.6 {info level option} {
3203     list [catch {info level 123a} msg] $msg
3204 } {1 {bad level "123a"}}
3205 test info-5.7 {info level option} {
3206     list [catch {info level 0} msg] $msg
3207 } {1 {bad level "0"}}
3208 test info-5.8 {info level option} {
3209     proc t1 {} {info level -1}
3210     list [catch {t1} msg] $msg
3211 } {1 {bad level "-1"}}
3212 test info-5.9 {info level option} {
3213     proc t1 {x} {info level $x}
3214     list [catch {t1 -3} msg] $msg
3215 } {1 {bad level "-3"}}
3216 test info-6.1 {info locals option} {
3217     set a 22
3218     proc t1 {x y} {
3219         set b 13
3220         set c testing
3221         global a
3222         global aa
3223         set aa 23
3224         return [info locals]
3225     }
3226     lsort [t1 23 24]
3227 } {b c x y}
3228 test info-6.2 {info locals option} {
3229     proc t1 {x y} {
3230         set xx1 2
3231         set xx2 3
3232         set y 4
3233         return [info locals x*]
3234     }
3235     lsort [t1 2 3]
3236 } {x xx1 xx2}
3237 test info-6.3 {info locals option} {
3238     list [catch {info locals 1 2} msg] $msg
3239 } {1 {wrong # args: should be "info locals ?pattern?"}}
3240 test info-6.4 {info locals option} {
3241     info locals
3242 } {}
3243 test info-6.5 {info locals option} {
3244     proc t1 {} {return [info locals]}
3245     t1
3246 } {}
3247 test info-6.6 {info locals vs unset compiled locals} {
3248     proc t1 {lst} {
3249         foreach $lst $lst {}
3250         unset lst
3251         return [info locals]
3252     }
3253     lsort [t1 {a b c c d e f}]
3254 } {a b c d e f}
3255 test info-6.7 {info locals with temporary variables} {
3256     proc t1 {} {
3257         foreach a {b c} {}
3258         info locals
3259     }
3260     t1
3261 } {a}
3262 test info-7.1 {info vars option} {
3263     set a 1
3264     set b 2
3265     proc t1 {x y} {
3266         global a b
3267         set c 33
3268         return [info vars]
3269     }
3270     lsort [t1 18 19]
3271 } {a b c x y}
3272 test info-7.2 {info vars option} {
3273     set xxx1 1
3274     set xxx2 2
3275     proc t1 {xxa y} {
3276         global xxx1 xxx2
3277         set c 33
3278         return [info vars x*]
3279     }
3280     lsort [t1 18 19]
3281 } {xxa xxx1 xxx2}
3282 test info-7.3 {info vars option} {
3283     lsort [info vars]
3284 } [lsort [info globals]]
3285 test info-7.4 {info vars option} {
3286     list [catch {info vars a b} msg] $msg
3287 } {1 {wrong # args: should be "info vars ?pattern?"}}
3288 test info-7.5 {info vars with temporary variables} {
3289     proc t1 {} {
3290         foreach a {b c} {}
3291         info vars
3292     }
3293     t1
3294 } {a}
3296 ################################################################################
3297 # RANGE
3298 ################################################################################
3300 test range-1.1 {basic range tests} {
3301     range 0 10
3302 } {0 1 2 3 4 5 6 7 8 9}
3304 test range-1.2 {basic range tests} {
3305     range 10 0 -1
3306 } {10 9 8 7 6 5 4 3 2 1}
3308 test range-1.3 {basic range tests} {
3309     range 1 10 11
3310 } {1}
3312 test range-1.4 {basic range tests} {
3313     range 1 10 11
3314 } {1}
3316 test range-1.5 {basic range tests} {
3317     range 10 10
3318 } {}
3320 test range-1.6 {basic range tests} {
3321     range 10 10 2
3322 } {}
3324 test range-1.7 {basic range test} {
3325     range 5
3326 } {0 1 2 3 4}
3328 test range-1.8 {basic range test} {
3329     range -10 -20 -2
3330 } {-10 -12 -14 -16 -18}
3332 test range-1.9 {basic range test} {
3333     range -20 -10 3
3334 } {-20 -17 -14 -11}
3336 test range-2.0 {foreach range test} {
3337     set k 0
3338     foreach {x y} [range 100] {
3339         incr k [expr {$x*$y}]
3340     }
3341     set k
3342 } {164150}
3344 test range-2.1 {foreach range test without obj reuse} {
3345     set k 0
3346     set trash {}
3347     foreach {x y} [range 100] {
3348         incr k [expr {$x*$y}]
3349         lappend trash $x $y
3350     }
3351     set trash {}
3352     set k
3353 } {164150}
3355 test range-2.2 {range element shimmering test} {
3356     set k {}
3357     foreach x [range 0 10] {
3358         append k [llength $x]
3359     }
3360     set k
3361 } {1111111111}
3363 test range-3.0 {llength range test} {
3364     llength [range 5000]
3365 } {5000}
3367 test range-3.1 {llength range test} {
3368     llength [range 5000 5000]
3369 } {0}
3371 test range-4.0 {lindex range test} {
3372     lindex [range 1000] 500
3373 } {500}
3375 test range-4.1 {lindex range test} {
3376     lindex [range 1000] end-2
3377 } {997}
3379 test range-5.0 {lindex llength range test} {
3380     set k 0
3381     set trash {}
3382     set r [range 100]
3383     for {set i 0} {$i < [llength $r]} {incr i 2} {
3384         incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}]
3385     }
3386     set trash {}
3387     set k
3388 } {164150}
3390 ################################################################################
3391 # SCOPE
3392 ################################################################################
3393 if 0 {
3394 test scope-1.0 {Non existing var} {
3395     catch {unset x}
3396     scope x {
3397         set x 10
3398         set y [+ $x 1]
3399     }
3400     list [info exists x] $y
3401 } {0 11}
3403 test scope-1.1 {Existing var restore} {
3404     set x 100
3405     scope x {
3406         for {set x 0} {$x < 10} {incr x} {}
3407     }
3408     set x
3409 } {100}
3411 test scope-1.2 {Mix of 1.0 and 1.1 tests} {
3412     catch {unset x}
3413     set y 10
3414     scope {x y} {
3415         set y 100
3416         set x 200
3417     }
3418     list [info exists x] $y
3419 } {0 10}
3421 test scope-1.3 {Array element} {
3422     set x "a 1 b 2"
3423     scope x(a) {
3424         set x(a) Hello!
3425     }
3426     set x(a)
3427 } {1}
3429 test scope-1.4 {Non existing array element} {
3430     catch {unset x}
3431     scope x(a) {
3432         set x(a) Hello!
3433     }
3434     info exists x(a)
3435 } {0}
3437 test scope-1.5 {Info exists} {
3438     set x foo
3439     scope x {
3440         info exists x
3441     }
3442 } {0}
3444 catch {unset x}
3445 catch {unset y}
3448 ################################################################################
3449 # RAND
3450 ################################################################################
3451 test rand-1.0 {Only one output is valid} {
3452     list [rand 100 100] [rand 101 101]
3453 } {100 101}
3455 test rand-1.1 {invalid arguments} {
3456     catch {rand 100 50} err
3457     set err
3458 } {Invalid arguments (max < min)}
3460 test rand-1.2 {Check limits} {
3461     set sum 0
3462     for {set i 0} {$i < 100} {incr i} {
3463         incr sum [expr {([rand $i] >= 0)+([rand $i] < 100)}]
3464     }
3465     set sum
3466 } {200}
3468 catch {unset sum; unset err; unset i}
3470 ################################################################################
3471 # JIM REGRESSION TESTS
3472 ################################################################################
3473 test regression-1.0 {Rename against procedures with static vars} {
3474     proc foobar {x} {{y 10}} {
3475         incr y $x
3476     }
3477     foobar 30
3478     foobar 20
3479     rename foobar barfoo
3480     list [barfoo 1] [barfoo 2] [barfoo 3]
3481 } {61 63 66}
3483 catch {rename barfoo {}}
3485 test regression-1.1 {lrange bug with negative indexes of type int} {
3486     lrange {a b c} 0 [- 0 1]
3487 } {}
3489 test regression-1.2 {open/close from non-global namespace} {
3490         proc a::b {} {
3491                 set f [open $::argv0]
3492                 $f close
3493                 return $f
3494         }
3495         set f [a::b]
3496         rename a::b ""
3497         expr {$f in [info channels]}
3498 } {0}
3501 testreport