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
8 # Sometimes tests are modified to reflect different error messages.
10 source [file dirname [info script]]/testing.tcl
13 catch {package require regexp}
14 testConstraint regexp [expr {[info commands regexp] ne {}}]
15 testConstraint lambda [expr {[info commands ref] ne {}}]
17 ################################################################################
19 ################################################################################
21 test set-1.2 {TclCompileSetCmd: simple variable name} {
26 test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
31 test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} {
37 test set-1.8 {TclCompileSetCmd: non-simple (computed) variable name} {
40 list [set [set x] 2] $i
43 test set-1.9 {TclCompileSetCmd: 3rd arg => assignment} {
48 test set-1.10 {TclCompileSetCmd: only two args => just getting value} {
53 test set-1.11 {TclCompileSetCmd: simple global name} {
62 test set-1.12 {TclCompileSetCmd: simple local name} {
70 test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} {
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
129 test set-1.17 {TclCompileSetCmd: doing assignment, simple int} {
134 test set-1.18 {TclCompileSetCmd: doing assignment, simple int} {
139 test set-1.19 {TclCompileSetCmd: doing assignment, simple but not int} {
145 test set-1.20 {TclCompileSetCmd: doing assignment, in quotes} {
150 test set-1.21 {TclCompileSetCmd: doing assignment, in braces} {
155 test set-1.22 {TclCompileSetCmd: doing assignment, large int} {
160 test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} {
162 set i 000012345 ;# a decimal literal == 5349 decimal
166 ################################################################################
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} {}
196 proc lcheck {testid a b c} {
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
220 ################################################################################
222 ################################################################################
224 test while-1.9 {TclCompileWhileCmd: simple command body} {
235 test while-1.10 {TclCompileWhileCmd: command body in quotes} {
238 while {$i<6} "append a x; incr i"
242 test while-1.13 {TclCompileWhileCmd: while command result} {
244 set a [while {$i < 5} {incr i}]
248 test while-1.14 {TclCompileWhileCmd: while command result} {
250 set a [while {$i < 5} {if $i==3 break; incr i}]
254 test while-2.1 {continue tests} {
259 if {$i == 3} continue
264 test while-2.2 {continue tests} {
269 if {$i != 2} continue
274 test while-2.3 {continue tests, nested loops} {
282 if {$i>=3 && $a>=3} continue
283 set msg [concat $msg "$i.$a"]
287 } {2.2 2.3 3.2 4.2 5.2}
289 test while-4.1 {while and computed command names} {
298 test while-5.2 {break tests with computed command names} {
310 test while-7.1 {delayed substitution of body} {
312 while {[incr i] < 10} "
317 while {[incr i] < 10} "
325 ################################################################################
327 ################################################################################
331 test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} {
333 list [eval [list $lset x 0 3]] $x
336 test lset-3.1 {lset, not compiled, 3 args, data duplicated} {
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} {
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} {
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} {
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} {
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} {
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} {
373 eval [list $lset a [list 2a2] w]
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} {
380 eval [list $lset a [list -1] w]
382 } {1 {list index out of range}}
384 test lset-4.4 {lset, not compiled, 3 args, index out of range} {
387 eval [list $lset a [list 3] w]
389 } {1 {list index out of range}}
391 test lset-4.5 {lset, not compiled, 3 args, index out of range} {
394 eval [list $lset a [list end--1] w]
396 } {1 {list index out of range}}
398 test lset-4.6 {lset, not compiled, 3 args, index out of range} {
401 eval [list $lset a [list end-3] w]
403 } {1 {list index out of range}}
405 test lset-4.8 {lset, not compiled, 3 args, bad index} {
408 eval [list $lset a 2a2 w]
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} {
415 eval [list $lset a -1 w]
417 } {1 {list index out of range}}
419 test lset-4.10 {lset, not compiled, 3 args, index out of range} {
422 eval [list $lset a 3 w]
424 } {1 {list index out of range}}
426 test lset-4.11 {lset, not compiled, 3 args, index out of range} {
429 eval [list $lset a end--1 w]
431 } {1 {list index out of range}}
433 test lset-4.12 {lset, not compiled, 3 args, index out of range} {
436 eval [list $lset a end-3 w]
438 } {1 {list index out of range}}
440 test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} {
442 list [eval [list $lset a 0 a]] $a
445 test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} {
447 list [eval [list $lset a [list 0] a]] $a
450 test lset-6.3 {lset, not compiled, 1-d list basics} {
452 list [eval [list $lset a 2 a]] $a
455 test lset-6.4 {lset, not compiled, 1-d list basics} {
457 list [eval [list $lset a [list 2] a]] $a
460 test lset-6.5 {lset, not compiled, 1-d list basics} {
462 list [eval [list $lset a end a]] $a
465 test lset-6.6 {lset, not compiled, 1-d list basics} {
467 list [eval [list $lset a [list end] a]] $a
470 test lset-6.7 {lset, not compiled, 1-d list basics} {
472 list [eval [list $lset a end-0 a]] $a
475 test lset-6.8 {lset, not compiled, 1-d list basics} {
477 list [eval [list $lset a [list end-0] a]] $a
479 test lset-6.9 {lset, not compiled, 1-d list basics} {
481 list [eval [list $lset a end-2 a]] $a
484 test lset-6.10 {lset, not compiled, 1-d list basics} {
486 list [eval [list $lset a [list end-2] a]] $a
489 test lset-7.1 {lset, not compiled, data sharing} {
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} {
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} {
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} {
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} {
512 list [eval [list $lset a $n $n]] $a $n
515 test lset-7.6 {lset, not compiled, data sharing} {
518 list [eval [list $lset a $n $n]] $a $n
521 test lset-7.7 {lset, not compiled, data sharing} {
524 list [eval [list $lset a $n 1]] $a $n
527 test lset-7.8 {lset, not compiled, data sharing} {
530 list [eval [list $lset a $n 1]] $a $n
533 test lset-7.9 {lset, not compiled, data sharing} {
535 list [eval [list $lset a $a $a]] $a
538 test lset-7.10 {lset, not compiled, data sharing} {
540 list [eval [list $lset a $a $a]] $a
543 test lset-8.3 {lset, not compiled, bad second index} {
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} {
570 list [eval [list $lset a y]] $a
573 test lset-10.1 {lset, not compiled, shared data} {
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} {
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} {
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} {
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} {
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} {
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]
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} {
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} {
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 }"
626 catch {unset noWrite}
627 catch {rename failTrace {}}
631 ################################################################################
633 ################################################################################
635 test if-1.1 {bad syntax: lacking all} {
638 test if-1.2 {bad syntax: lacking then-clause} {
641 test if-1.3 {bad syntax: lacking then-clause 2} {
644 test if-1.4 {bad syntax: lacking else-clause after keyword 'else'} {
645 catch {if 1==0 then {list 1} else}
647 test if-1.5 {bad syntax: lacking expr after 'elseif'} {
648 catch {if 1==0 then {list 1} elseif}
650 test if-1.6 {bad syntax: lacking then-clause after 'elseif'} {
651 catch {if 1==0 then {list 1} elseif 1==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}
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}
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}}
662 test if-2.1 {taking proper branch} {
664 if 0 {set a 1} else {set a 2}
667 test if-2.2 {taking proper branch} {
669 if 1 {set a 1} else {set a 2}
672 test if-2.3 {taking proper branch} {
677 test if-2.4 {taking proper branch} {
682 test if-2.5 {taking proper branch} {
684 if 0 {set a 1} else {}
687 test if-2.6 {taking proper branch} {
689 if 0 {set a 1} elseif 1 {set a 2} elseif 1 {set a 3} else {set a 4}
692 test if-2.7 {taking proper branch} {
694 if 0 {set a 1} elseif 0 {set a 2} elseif 1 {set a 3} else {set a 4}
697 test if-2.8 {taking proper branch} {
699 if 0 {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} else {set a 4}
702 test if-2.9 {taking proper branch, multiline test expr} {
705 3} {set a 3} else {set a 4}
708 test if-3.1 {optional then-else args} {
710 if 0 then {set a 1} elseif 0 then {set a 3} else {set a 2}
713 test if-3.2 {optional then-else args} {
715 if 1 then {set a 1} else {set a 2}
718 test if-3.3 {optional then-else args} {
720 if 0 {set a 1} else {set a 2}
723 test if-3.4 {optional then-else args} {
725 if 1 {set a 1} else {set a 2}
728 test if-3.5 {optional then-else args} {
730 if 0 then {set a 1} {set a 2}
733 test if-3.6 {optional then-else args} {
735 if 1 then {set a 1} {set a 2}
738 test if-3.7 {optional then-else args} {
740 if 0 then {set a 1} else {set a 2}
743 test if-3.8 {optional then-else args} {
745 if 0 then {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} {set a 4}
748 test if-4.1 {return value} {
749 if 1 then {set a 22; concat abc}
751 test if-4.2 {return value} {
752 if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
754 test if-4.3 {return value} {
755 if 0 then {set a 22; concat abc} else {concat def}
757 test if-4.4 {return value} {
758 if 0 then {set a 22; concat abc}
760 test if-4.5 {return value} {
761 if 0 then {set a 22; concat abc} elseif 0 {concat def}
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 ################################################################################
784 ################################################################################
788 test append-1.1 {append command} {
790 list [append x 1 2 abc "long string"] $x
791 } {{12abclong string} {12abclong string}}
792 test append-1.2 {append command} {
794 list [append x first] [append x second] [append x third] $x
795 } {first firstsecond firstsecondthird firstsecondthird}
796 test append-1.3 {append command} {
801 test append-2.1 {long appends} {
803 for {set i 0} {$i < 1000} {set i [expr $i+1]} {
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 "
813 test append-3.1 {append errors} {
814 list [catch {append} msg] $msg
815 } {1 {wrong # args: should be "append varName ?value ...?"}}
816 test append-3.2 {append errors} {
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} {
822 list [catch {append x} msg] $msg
823 } {1 {can't read "x": no such variable}}
825 test append-4.1 {lappend command} {
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} {
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} {
844 test append-4.4 {lappend command} {
848 test append-4.5 {lappend command} {
852 test append-4.6 {lappend command} {
856 test append-4.7 {lappend command} {
860 test append-4.8 {lappend command} {
864 #test append-4.9 {lappend command} {
866 # list [catch {lappend x abc} msg] $msg
867 #} {1 {unmatched open brace in list}}
868 #test append-4.10 {lappend command} {
870 # list [catch {lappend x abc} msg] $msg
871 #} {1 {unmatched open brace in list}}
872 #test append-4.11 {lappend command} {
874 # list [catch {lappend x abc} msg] $msg
875 #} {1 {unmatched open brace in list}}
876 #test append-4.12 {lappend command} {
878 # list [catch {lappend x abc} msg] $msg
879 #} {1 {unmatched open brace in list}}
880 test append-4.13 {lappend command} {
883 } "x\\\{\\\{\\\{ abc"
884 test append-4.14 {lappend command} {
888 test append-4.15 {lappend command} {
892 test append-4.16 {lappend command} {
896 test append-4.17 {lappend command} {
900 test append-4.18 {lappend command} {
904 test append-4.19 {lappend command} {
908 test append-4.20 {lappend command} {
913 proc check {var size} {
916 return "length mismatch: should have been $size, was $l"
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\""
926 test append-5.1 {long lappends} {
929 for {set i 0} {$i < 300} {set i [expr $i+1]} {
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} {
940 list [catch {lappend x(0) 44} msg] $msg
941 } {1 {can't set "x(0)": variable isn't array}}
943 ################################################################################
945 ################################################################################
948 newset z [expr $x+$y]
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} {
960 test uplevel-1.2 {command is another uplevel command} {
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} {
999 test uplevel-3.2 {uplevel to same level} {
1003 test uplevel-3.3 {uplevel to same level} {
1005 proc a1 {} {set y 55; uplevel 0 set y 66; return $y}
1008 test uplevel-3.4 {uplevel to same level} {
1010 proc a1 {} {set y 55; uplevel #1 set y}
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 ...?"}}
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 ################################################################################
1043 ################################################################################
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} {
1057 test unknown-2.1 {calling "unknown" command} {
1061 test unknown-2.2 {calling "unknown" command with lots of args} {
1062 foobar 1 2 3 4 5 6 7
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
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
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 \]
1077 } "foobar \\{ \\} a\\{b {;} \\\\ {\$a} {a\[b} \\]"
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}}
1089 ################################################################################
1091 ################################################################################
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} {
1103 #test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
1105 # catch {incr "i"xxx} msg
1107 #} {extra characters after close-quote}
1108 test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
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}
1117 test incr-1.6 {TclCompileIncrCmd: simple array variable name} {
1120 list [incr a(foo)] $a(foo)
1122 test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
1127 test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
1130 list [incr [set x] +2] $i
1133 test incr-1.9 {TclCompileIncrCmd: increment given} {
1135 list [incr i +07] $i
1137 test incr-1.10 {TclCompileIncrCmd: no increment given} {
1142 test incr-1.11 {TclCompileIncrCmd: simple global name} {
1150 test incr-1.12 {TclCompileIncrCmd: simple local name} {
1157 test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} {
1164 test incr-1.14 {TclCompileIncrCmd: simple local name, >255 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)
1224 test incr-1.15 {TclCompileIncrCmd: variable is array} {
1227 set x [incr a(foo) 11]
1231 test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} {
1235 set x [incr a(foo$i) 11]
1240 test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
1244 test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
1248 #test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} {
1250 # catch {incr i [set]} msg
1252 #} {wrong # args: should be "set varName ?newValue?"
1257 test incr-1.20 {TclCompileIncrCmd: increment given, in quotes} {
1261 test incr-1.21 {TclCompileIncrCmd: increment given, in braces} {
1265 test incr-1.22 {TclCompileIncrCmd: increment given, large int} {
1269 test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
1271 incr i 000012345 ;# a decimal literal
1273 test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
1275 catch {incr i 1a} msg
1277 } {expected integer but got "1a"}
1279 test incr-1.25 {TclCompileIncrCmd: too many arguments} {
1281 catch {incr i 10 20} msg
1283 } {wrong # args: should be "incr varName ?increment?"}
1286 test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
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)} {
1297 # Check "incr" and computed command names.
1299 test incr-2.0 {incr and computed command names} {
1308 test incr-2.1 {incr command (not compiled): missing variable name} {
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} {
1317 test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
1322 test incr-2.5 {incr command (not compiled): simple variable name in braces} {
1324 catch {unset {a simple var}}
1325 set {a simple var} 27
1326 list [$z {a simple var}] ${a simple var}
1328 test incr-2.6 {incr command (not compiled): simple array variable name} {
1332 list [$z a(foo)] $a(foo)
1334 test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
1340 test incr-2.8 {incr command (not compiled): non-simple (computed) variable name} {
1344 list [$z [set x] +2] $i
1347 test incr-2.9 {incr command (not compiled): increment given} {
1352 test incr-2.10 {incr command (not compiled): no increment given} {
1358 test incr-2.11 {incr command (not compiled): simple global name} {
1367 test incr-2.12 {incr command (not compiled): simple local name} {
1375 test incr-2.13 {incr command (not compiled): simple but new (unknown) local name} {
1383 test incr-2.14 {incr command (not compiled): simple local name, >255 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)
1444 test incr-2.15 {incr command (not compiled): variable is array} {
1448 set x [$z a(foo) 11]
1452 test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} {
1457 set x [$z a(foo$i) 11]
1462 test incr-2.17 {incr command (not compiled): increment given, simple int} {
1467 test incr-2.18 {incr command (not compiled): increment given, simple int} {
1472 test incr-2.20 {incr command (not compiled): increment given, in quotes} {
1477 test incr-2.21 {incr command (not compiled): increment given, in braces} {
1482 test incr-2.22 {incr command (not compiled): increment given, large int} {
1487 test incr-2.23 {incr command (not compiled): increment given, formatted int != int} {
1490 $z i 000012345 ;# an octal literal
1492 test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
1497 } {expected integer but got "1a"}
1499 test incr-2.25 {incr command (not compiled): too many arguments} {
1502 catch {$z i 10 20} msg
1504 } {wrong # args: should be "incr varName ?increment?"}
1506 test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
1509 list [catch {$z x 1} msg] $msg
1510 } {1 {expected integer but got " - "}}
1512 ################################################################################
1514 ################################################################################
1516 test llength-1.1 {length of list} {
1519 test llength-1.2 {length of list} {
1520 llength {a b c {a b {c d}} d}
1522 test llength-1.3 {length of list} {
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 ################################################################################
1535 ################################################################################
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} {
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} {
1555 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1558 test lindex-2.4 {malformed index list} {
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} {
1567 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
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]]
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]]
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]]
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} {
1594 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1597 test lindex-4.2 {index = end--1} {
1599 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1602 test lindex-4.3 {index = end-0} {
1604 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1607 test lindex-4.4 {index = end-2} {
1609 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1612 test lindex-4.5 {index = end-3} {
1614 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1617 test lindex-4.8 {bad integer, not octal} {
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} {
1624 # list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1627 test lindex-4.10 {incomplete 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]
1640 test lindex-5.3 {three indices} {
1641 eval [list $lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1]
1644 test lindex-7.1 {quoted elements} {
1645 eval [list $lindex {a "b c" d} 1]
1647 test lindex-7.2 {quoted elements} {
1648 eval [list $lindex {"{}" b c} 0]
1650 test lindex-7.3 {quoted elements} {
1651 eval [list $lindex {ab "c d \" x" y} 1]
1653 test lindex-7.4 {quoted elements} {
1654 lindex {a b {c d "e} {f g"}} 2
1657 test lindex-8.1 {data reuse} {
1659 eval [list $lindex $x $x]
1662 test lindex-8.2 {data reuse} {
1664 eval [list $lindex $a $a $a]
1666 test lindex-8.3 {data reuse} {
1668 eval [list $lindex $a $a $a]
1671 #----------------------------------------------------------------------
1673 test lindex-10.2 {singleton index list} {
1676 list [lindex {a b c} $x] [lindex {a b c} $x]
1681 test lindex-10.4 {malformed index list} {
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} {
1691 list [lindex {a b c} $x] [lindex {a b c} $x]
1696 test lindex-11.2 {integer 0} {
1697 set x [string range 00 0 0]
1699 list [lindex {a b c} $x] [lindex {a b c} $x]
1704 test lindex-11.3 {integer 2} {
1705 set x [string range 22 0 0]
1707 list [lindex {a b c} $x] [lindex {a b c} $x]
1712 test lindex-11.4 {integer 3} {
1713 set x [string range 33 0 0]
1715 list [lindex {a b c} $x] [lindex {a b c} $x]
1720 # Indices relative to end
1721 test lindex-12.1 {index = end} {
1724 list [lindex {a b c} $x] [lindex {a b c} $x]
1729 test lindex-12.2 {index = end--1} {
1732 list [lindex {a b c} $x] [lindex {a b c} $x]
1737 test lindex-12.3 {index = end-0} {
1740 list [lindex {a b c} $x] [lindex {a b c} $x]
1745 test lindex-12.4 {index = end-2} {
1748 list [lindex {a b c} $x] [lindex {a b c} $x]
1753 test lindex-12.5 {index = end-3} {
1756 list [lindex {a b c} $x] [lindex {a b c} $x]
1761 test lindex-12.8 {bad integer, not octal} {
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-} {
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} {
1777 lindex {{a b c} {d e f} {g h i}} 1 2
1782 test lindex-13.3 {three indices} {
1784 lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1
1789 test lindex-15.1 {quoted elements} {
1791 lindex {a "b c" d} 1
1795 test lindex-15.2 {quoted elements} {
1801 test lindex-15.3 {quoted elements} {
1803 lindex {ab "c d \" x" y} 1
1807 test lindex-15.4 {quoted elements} {
1809 lindex {a b {c d "e} {f g"}} 2
1814 test lindex-16.1 {data reuse} {
1822 test lindex-16.2 {data reuse} {
1829 test lindex-16.3 {data reuse} {
1837 test lindex-17.1 {no index} {
1841 catch { unset lindex}
1842 catch { unset minus }
1844 ################################################################################
1846 ################################################################################
1851 # Basic "foreach" operation.
1853 test foreach-1.1 {basic foreach tests} {
1855 foreach i {a b c d} {
1856 set a [concat $a $i]
1860 test foreach-1.2 {basic foreach tests} {
1862 foreach i {a b {{c d} e} {123 {{x}}}} {
1863 set a [concat $a $i]
1866 } {a b {c d} e 123 {{x}}}
1867 test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1
1868 test foreach-1.4 {basic foreach tests} {catch {foreach i} msg} 1
1869 test foreach-1.5 {basic foreach tests} {catch {foreach i j} msg} 1
1870 test foreach-1.6 {basic foreach tests} {catch {foreach i j k l} msg} 1
1871 test foreach-1.7 {basic foreach tests} {
1874 set a [concat $a $i]
1879 test foreach-2.1 {foreach errors} {
1880 list [catch {foreach {} {} {}} msg] $msg
1881 } {1 {foreach varlist is empty}}
1884 test foreach-3.1 {parallel foreach tests} {
1886 foreach {a b} {1 2 3 4} {
1891 test foreach-3.2 {parallel foreach tests} {
1893 foreach {a b} {1 2 3 4 5} {
1898 test foreach-3.3 {parallel foreach tests} {
1900 foreach a {1 2 3} b {4 5 6} {
1905 test foreach-3.4 {parallel foreach tests} {
1907 foreach a {1 2 3} b {4 5 6 7 8} {
1912 test foreach-3.5 {parallel foreach tests} {
1914 foreach {a b} {a b A B aa bb} c {c C cc CC} {
1919 test foreach-3.6 {parallel foreach tests} {
1921 foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
1922 append x $a $b $c $d $e
1926 test foreach-3.7 {parallel foreach tests} {
1928 foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
1929 append x $a $b $c $d $e
1933 test foreach-4.1 {foreach only sets vars if repeating loop} {
1936 foreach {r g b} [set rgb] {}
1937 return "r=$r, g=$g, b=$b"
1940 } {r=65535, g=0, b=0}
1941 test foreach-5.1 {foreach supports dict syntactic sugar} {
1944 foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]}
1950 test foreach-6.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
1952 foreach {12.0} {a b c} {
1961 test foreach-7.1 {continue tests} {catch continue} 4
1962 test foreach-7.2 {continue tests} {
1964 foreach i {a b c d} {
1965 if {[string compare $i "b"] == 0} continue
1966 set a [concat $a $i]
1970 test foreach-7.3 {continue tests} {
1972 foreach i {a b c d} {
1973 if {[string compare $i "b"] != 0} continue
1974 set a [concat $a $i]
1978 test foreach-7.4 {continue tests} {catch {continue foo} msg} 1
1979 test foreach-7.5 {continue tests} {
1980 catch {continue foo} msg
1982 } {wrong # args: should be "continue"}
1986 test foreach-8.1 {break tests} {catch break} 3
1987 test foreach-8.2 {break tests} {
1989 foreach i {a b c d} {
1990 if {[string compare $i "c"] == 0} break
1991 set a [concat $a $i]
1995 test foreach-8.3 {break tests} {catch {break foo} msg} 1
1996 test foreach-8.4 {break tests} {
1997 catch {break foo} msg
1999 } {wrong # args: should be "break"}
2001 # Test for incorrect "double evaluation" semantics
2003 test foreach-9.1 {delayed substitution of body - knownbugs} {
2006 foreach a [list 1 2 3] "
2018 ################################################################################
2020 ################################################################################
2023 test string-7.1 {string last, too few args} {
2024 list [catch {string last a} msg] $msg
2025 } {1 {wrong # args: should be "string last subString string ?index?"}}
2026 test string-7.2 {string last, bad args} {
2027 list [catch {string last a b c} msg] $msg
2028 } {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
2029 test string-7.3 {string last, too many args} {
2030 list [catch {string last a b c d} msg] $msg
2031 } {1 {wrong # args: should be "string last subString string ?index?"}}
2032 test string-7.5 {string last} {
2033 string last xx xxxx123xx345x678
2035 test string-7.13 {string last, start index} {
2036 ## Constrain to last 'a' should work
2037 string last ba badbad end-1
2039 test string-7.14 {string last, start index} {
2040 ## Constrain to last 'b' should skip last 'ba'
2041 string last ba badbad end-2
2046 test string-11.1 {string match, too few args} {
2047 proc foo {} {string match a}
2048 list [catch {foo} msg] $msg
2049 } {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
2050 test string-11.2 {string match, too many args} {
2051 proc foo {} {string match a b c d}
2052 list [catch {foo} msg] $msg
2053 } {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
2054 test string-11.3 {string match} {
2055 proc foo {} {string match abc abc}
2058 #test string-11.4 {string match} {
2059 # proc foo {} {string mat abc abd}
2062 test string-11.5 {string match} {
2063 proc foo {} {string match ab*c abc}
2066 test string-11.6 {string match} {
2067 proc foo {} {string match ab**c abc}
2070 test string-11.7 {string match} {
2071 proc foo {} {string match ab* abcdef}
2074 test string-11.8 {string match} {
2075 proc foo {} {string match *c abc}
2078 test string-11.9 {string match} {
2079 proc foo {} {string match *3*6*9 0123456789}
2082 test string-11.10 {string match} {
2083 proc foo {} {string match *3*6*9 01234567890}
2086 test string-11.11 {string match} {
2087 proc foo {} {string match a?c abc}
2090 test string-11.12 {string match} {
2091 proc foo {} {string match a??c abc}
2094 test string-11.13 {string match} {
2095 proc foo {} {string match ?1??4???8? 0123456789}
2098 test string-11.14 {string match} {
2099 proc foo {} {string match {[abc]bc} abc}
2102 test string-11.15 {string match} {
2103 proc foo {} {string match {a[abc]c} abc}
2106 test string-11.16 {string match} {
2107 proc foo {} {string match {a[xyz]c} abc}
2110 test string-11.17 {string match} {
2111 proc foo {} {string match {12[2-7]45} 12345}
2114 test string-11.18 {string match} {
2115 proc foo {} {string match {12[ab2-4cd]45} 12345}
2118 test string-11.19 {string match} {
2119 proc foo {} {string match {12[ab2-4cd]45} 12b45}
2122 test string-11.20 {string match} {
2123 proc foo {} {string match {12[ab2-4cd]45} 12d45}
2126 test string-11.21 {string match} {
2127 proc foo {} {string match {12[ab2-4cd]45} 12145}
2130 test string-11.22 {string match} {
2131 proc foo {} {string match {12[ab2-4cd]45} 12545}
2134 test string-11.23 {string match} {
2135 proc foo {} {string match {a\*b} a*b}
2138 test string-11.24 {string match} {
2139 proc foo {} {string match {a\*b} ab}
2142 test string-11.25 {string match} {
2143 proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
2146 test string-11.26 {string match} {
2147 proc foo {} {string match ** ""}
2150 test string-11.27 {string match} {
2151 proc foo {} {string match *. ""}
2154 test string-11.28 {string match} {
2155 proc foo {} {string match "" ""}
2158 test string-11.29 {string match} {
2159 proc foo {} {string match \[a a}
2162 test string-11.31 {string match case} {
2163 proc foo {} {string match a A}
2166 test string-11.32 {string match nocase} {
2167 proc foo {} {string match -n a A}
2170 #test string-11.33 {string match nocase} {
2171 # proc foo {} {string match -nocase a\334 A\374}
2174 test string-11.34 {string match nocase} {
2175 proc foo {} {string match -nocase a*f ABCDEf}
2178 test string-11.35 {string match case, false hope} {
2179 # This is true because '_' lies between the A-Z and a-z ranges
2180 proc foo {} {string match {[A-z]} _}
2183 test string-11.36 {string match nocase range} {
2184 # This is false because although '_' lies between the A-Z and a-z ranges,
2185 # we lower case the end points before checking the ranges.
2186 proc foo {} {string match -nocase {[A-z]} _}
2189 test string-11.37 {string match nocase} {
2190 proc foo {} {string match -nocase {[A-fh-Z]} g}
2193 test string-11.38 {string match case, reverse range} {
2194 proc foo {} {string match {[A-fh-Z]} g}
2197 test string-11.39 {string match, *\ case} {
2198 proc foo {} {string match {*\abc} abc}
2201 test string-11.40 {string match, *special case} {
2202 proc foo {} {string match {*[ab]} abc}
2205 test string-11.41 {string match, *special case} {
2206 proc foo {} {string match {*[ab]*} abc}
2209 #test string-11.42 {string match, *special case} {
2210 # proc foo {} {string match "*\\" "\\"}
2213 test string-11.43 {string match, *special case} {
2214 proc foo {} {string match "*\\\\" "\\"}
2217 test string-11.44 {string match, *special case} {
2218 proc foo {} {string match "*???" "12345"}
2221 test string-11.45 {string match, *special case} {
2222 proc foo {} {string match "*???" "12"}
2225 test string-11.46 {string match, *special case} {
2226 proc foo {} {string match "*\\*" "abc*"}
2229 test string-11.47 {string match, *special case} {
2230 proc foo {} {string match "*\\*" "*"}
2233 test string-11.48 {string match, *special case} {
2234 proc foo {} {string match "*\\*" "*abc"}
2237 test string-11.49 {string match, *special case} {
2238 proc foo {} {string match "?\\*" "a*"}
2241 #test string-11.50 {string match, *special case} {
2242 # proc foo {} {string match "\\" "\\"}
2248 test string-9.1 {string length} {
2249 proc foo {} {string length}
2250 list [catch {foo} msg] $msg
2251 } {1 {wrong # args: should be "string length string"}}
2252 test string-9.2 {string length} {
2253 proc foo {} {string length a b}
2254 list [catch {foo} msg] $msg
2255 } {1 {wrong # args: should be "string length string"}}
2256 test string-9.3 {string length} {
2257 proc foo {} {string length "a little string"}
2263 test string-10.4 {string map} {
2264 string map {a b} abba
2266 test string-10.5 {string map} {
2269 test string-10.6 {string map -nocase} {
2270 string map -nocase {a b} Abba
2272 test string-10.7 {string map} {
2273 string map {abc 321 ab * a A} aabcabaababcab
2275 test string-10.8 {string map -nocase} {
2276 string map -nocase {aBc 321 Ab * a A} aabcabaababcab
2278 test string-10.10 {string map} {
2279 list [catch {string map {a b c} abba} msg] $msg
2280 } {1 {list must contain an even number of elements}}
2281 test string-10.11 {string map, nulls} {
2282 string map {\x00 NULL blah \x00nix} {qwerty}
2284 test string-10.12 {string map, unicode} {
2285 string map [list \u00fc ue UE \u00dc] "a\u00fcueUE\000EU"
2287 test string-10.13 {string map, -nocase unicode} {
2288 string map -nocase [list \u00fc ue UE \u00dc] "a\u00fcueUE\000EU"
2289 } aue\u00dc\u00dc\0EU
2290 test string-10.14 {string map, -nocase null arguments} {
2291 string map -nocase {{} abc} foo
2293 test string-10.15 {string map, one pair case} {
2294 string map -nocase {abc 32} aAbCaBaAbAbcAb
2296 test string-10.16 {string map, one pair case} {
2297 string map -nocase {ab 4321} aAbCaBaAbAbcAb
2298 } {a4321C4321a43214321c4321}
2299 test string-10.17 {string map, one pair case} {
2300 string map {Ab 4321} aAbCaBaAbAbcAb
2301 } {a4321CaBa43214321c4321}
2302 test string-10.18 {string map, empty argument} {
2303 string map -nocase {{} abc} foo
2305 test string-10.19 {string map, empty arguments} {
2306 string map -nocase {{} abc f bar {} def} foo
2309 ################################################################################
2311 ################################################################################
2313 test split-1.1 {basic split commands} {
2314 split "a\n b\t\r c\n "
2315 } {a {} b {} {} c {} {}}
2316 test split-1.2 {basic split commands} {
2317 split "word 1xyzword 2zword 3" xyz
2318 } {{word 1} {} {} {word 2} {word 3}}
2319 test split-1.3 {basic split commands} {
2322 test split-1.4 {basic split commands} {
2323 split "a\}b\[c\{\]\$"
2324 } "a\\}b\\\[c\\{\\\]\\\$"
2325 test split-1.5 {basic split commands} {
2328 test split-1.6 {basic split commands} {
2331 test split-1.7 {basic split commands} {
2334 test split-1.8 {basic split commands} {
2337 foreach f [split {]\n} {}] {
2344 test split-1.9 {basic split commands} {
2352 test split-1.10 {basic split commands} {
2353 split "a0ab1b2bbb3\000c4" ab\000c
2354 } {{} 0 {} 1 2 {} {} 3 {} 4}
2355 test split-1.11 {basic split commands} {
2358 test split-1.12 {basic split commands} {
2359 split "\u0001ab\u0001cd\u0001\u0001ef\u0001" \1
2360 } {{} ab cd {} ef {}}
2361 test split-1.13 {basic split commands} {
2362 split "12,34,56," {,}
2364 test split-1.14 {basic split commands} {
2365 split ",12,,,34,56," {,}
2366 } {{} 12 {} {} 34 56 {}}
2368 test split-2.1 {split errors} {
2369 list [catch split msg] $msg
2370 } {1 {wrong # args: should be "split string ?splitChars?"}}
2371 test split-2.2 {split errors} {
2372 list [catch {split a b c} msg] $msg
2373 } {1 {wrong # args: should be "split string ?splitChars?"}}
2376 catch {rename foo {}}
2378 ################################################################################
2380 ################################################################################
2382 test join-1.1 {basic join commands} {
2385 test join-1.2 {basic join commands} {
2388 test join-1.3 {basic join commands} {
2391 test join-1.4 {basic join commands} {
2395 test join-2.1 {join errors} {
2396 list [catch join msg] $msg
2397 } {1 {wrong # args: should be "join list ?joinString?"}}
2398 test join-2.2 {join errors} {
2399 list [catch {join a b c} msg] $msg
2400 } {1 {wrong # args: should be "join list ?joinString?"}}
2401 #test join-2.3 {join errors} {
2402 # list [catch {join "a \{ c" 111} msg] $msg
2403 #} {1 {unmatched open brace in list}}
2405 test join-3.1 {joinString is binary ok} {
2406 string length [join {a b c} a\0b]
2409 test join-3.2 {join is binary ok} {
2410 string length [join "a\0b a\0b a\0b"]
2413 ################################################################################
2415 ################################################################################
2417 test switch-1.1 {simple patterns} {
2418 switch a a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2420 test switch-1.2 {simple patterns} {
2421 switch b a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2423 test switch-1.3 {simple patterns} {
2424 switch x a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2426 test switch-1.4 {simple patterns} {
2427 switch x a {expr 1} b {expr 2} c {expr 3}
2429 test switch-1.5 {simple pattern matches many times} {
2430 switch b a {expr 1} b {expr 2} b {expr 3} b {expr 4}
2432 test switch-1.6 {simple patterns} {
2433 switch default a {expr 1} default {expr 2} c {expr 3} default {expr 4}
2435 test switch-1.7 {simple patterns} {
2436 switch x a {expr 1} default {expr 2} c {expr 3} default {expr 4}
2439 test switch-2.1 {single-argument form for pattern/command pairs} {
2446 test switch-2.2 {single-argument form for pattern/command pairs} {
2447 list [catch {switch z {a 2 b}}]
2450 test switch-3.1 {-exact vs. -glob vs. -regexp} {
2451 switch -exact aaaab {
2452 ^a*b$ {concat regexp}
2454 aaaab {concat exact}
2455 default {concat none}
2458 test switch-3.2 {-exact vs. -glob vs. -regexp (no [regexp] cmd)} regexp {
2459 rename regexp regexp.none
2461 switch -regexp aaaab {
2462 ^a*b$ {concat regexp}
2464 aaaab {concat exact}
2465 default {concat none}
2468 rename regexp.none regexp
2472 test switch-3.3 {-exact vs. -glob vs. -regexp (with [regexp] cmd)} regexp {
2473 switch -regexp aaaab {
2474 ^a*b$ {concat regexp}
2476 aaaab {concat exact}
2477 default {concat none}
2480 test switch-3.4 {-exact vs. -glob vs. -regexp} {
2481 switch -glob aaaab {
2482 ^a*b$ {concat regexp}
2484 aaaab {concat exact}
2485 default {concat none}
2488 test switch-3.5 {-exact vs. -glob vs. -regexp} {
2489 switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
2490 aaaab {concat exact} default {concat none}
2492 test switch-3.6 {-exact vs. -glob vs. -regexp} {
2494 ^g.*b$ {concat regexp}
2496 -glob {concat exact}
2497 default {concat none}
2500 test switch-3.7 {-exact vs. -glob vs. -regexp} {
2501 list [catch {switch -foo a b c} msg] $msg
2502 } {1 {bad option "-foo": must be -exact, -glob, -regexp, -command procname or --}}
2504 test switch-4.1 {error in executed command} {
2505 list [catch {switch a a {error "Just a test"} default {expr 1}} msg] \
2508 test switch-4.2 {error: not enough args} {
2511 test switch-4.3 {error: pattern with no body} {
2514 test switch-4.4 {error: pattern with no body} {
2515 catch {switch a b {expr 1} c}
2517 test switch-4.5 {error in default command} {
2518 list [catch {switch foo a {error switch1} b {error switch 3} \
2519 default {error switch2}} msg] $msg
2522 test switch-5.1 {errors in -regexp matching} regexp {
2523 catch {switch -regexp aaaab {
2525 aaaab {concat exact}
2526 default {concat none}
2530 test switch-6.1 {backslashes in patterns} {
2531 switch -exact {\a\$\.\[} {
2532 \a\$\.\[ {concat first}
2533 \a\\$\.\\[ {concat second}
2534 \\a\\$\\.\\[ {concat third}
2535 {\a\\$\.\\[} {concat fourth}
2536 {\\a\\$\\.\\[} {concat fifth}
2537 default {concat none}
2540 test switch-6.2 {backslashes in patterns} {
2541 switch -exact {\a\$\.\[} {
2542 \a\$\.\[ {concat first}
2543 {\a\$\.\[} {concat second}
2544 {{\a\$\.\[}} {concat third}
2545 default {concat none}
2549 test switch-7.1 {"-" bodies} {
2557 test switch-7.2 {"-" bodies} {
2565 } {1 {no body specified for pattern "c"}}
2566 # Following original Tcl test makes no sense, I feel! Please review ...
2567 #~ test switch-7.3 {"-" bodies} {
2575 #~ } {1 {no body specified for pattern "c"}}
2576 test switch-7.3 {"-" bodies} {
2584 } {1 {invalid command name "-foo"}}
2586 test switch-8.1 {empty body} {
2595 test switch-9.1 {empty pattern/body list} {
2598 test switch-9.2 {empty pattern/body list} {
2601 test switch-9.3 {empty pattern/body list} {
2604 test switch-9.4 {empty pattern/body list} {
2605 catch {switch -- x {}}
2607 test switch-9.5 {unpaired pattern} {
2608 catch {switch x a {} b}
2610 test switch-9.6 {unpaired pattern} {
2611 catch {switch x {a {} b}}
2613 test switch-9.7 {unpaired pattern} {
2614 catch {switch x a {} # comment b}
2616 test switch-9.8 {unpaired pattern} {
2617 catch {switch x {a {} # comment b}}
2619 test switch-9.9 {unpaired pattern} {
2620 catch {switch x a {} x {} # comment b}
2622 test switch-9.10 {unpaired pattern} {
2623 catch {switch x {a {} x {} # comment b}}
2626 test switch-10.1 {no callback given to -command} {
2627 catch {switch -command a { a {expr 1} b {expr 2} }}
2629 test switch-10.2 {callback expect wrong # args for -command} lambda {
2630 catch {switch -command [lambda {p1} {expr 1}] a { a {expr 1} b {expr 2} }}
2632 test switch-10.3 {callback to -command returns ever 0: no match} lambda {
2633 switch -command [lambda {p1 p2} {expr 0}] a a {expr 1} b {expr 2}
2635 test switch-10.4 {callback to -command returns 3 at first match} lambda {
2636 switch -command [lambda {p1 p2} {expr 3}] a a {expr 1} b {expr 2}
2638 test switch-10.5 {[error] in callback to -command} lambda {
2640 switch -command [lambda {p1 p2} {error "foo"}] a a {expr 1} b {expr 2}
2643 test switch-10.6 {[continue] in callback to -command} lambda {
2645 switch -command [lambda {p1 p2} {continue}] a a {expr 1} b {expr 2}
2648 test switch-10.7 {callback matches first if pat < str} lambda {
2649 switch -command [lambda {pat str} {expr {$pat < $str}}] 3 \
2650 5 {expr 1} 3 {expr 2}
2652 test switch-10.8 {callback matches first if pat < str} lambda {
2653 switch -command [lambda {pat str} {expr {$pat < $str}}] 7 \
2654 5 {expr 1} 3 {expr 2}
2656 test switch-10.9 {callback matches first if pat < str} lambda {
2657 switch -command [lambda {pat str} {expr {$pat < $str}}] 4 \
2658 5 {expr 1} 3 {expr 2}
2661 ################################################################################
2663 ################################################################################
2665 # Basic "for" operation.
2666 test for-1.1 {TclCompileForCmd: missing initial command} {
2667 list [catch {for} msg] $msg
2668 } {1 {wrong # args: should be "for start test next body"}}
2669 test for-1.2 {TclCompileForCmd: error in initial command} {
2670 list [catch {for {set}} msg] $msg
2671 } {1 {wrong # args: should be "for start test next body"}}
2673 test for-1.3 {TclCompileForCmd: missing test expression} {
2674 catch {for {set i 0}} msg
2676 } {wrong # args: should be "for start test next body"}
2677 test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
2679 for {} "$i > 5" {incr i} {}
2681 test for-1.6 {TclCompileForCmd: missing "next" command} {
2682 catch {for {set i 0} {$i < 5}} msg
2684 } {wrong # args: should be "for start test next body"}
2685 test for-1.7 {TclCompileForCmd: missing command body} {
2686 catch {for {set i 0} {$i < 5} {incr i}} msg
2688 } {wrong # args: should be "for start test next body"}
2690 test for-1.9 {TclCompileForCmd: simple command body} {
2692 for {set i 1} {$i<6} {set i [expr $i+1]} {
2694 set a [concat $a $i]
2698 test for-1.10 {TclCompileForCmd: command body in quotes} {
2700 for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2703 test for-1.11 {TclCompileForCmd: computed command body} {
2707 set x1 {append a x1; }
2709 set x2 {; append a x2}
2711 for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
2714 test for-1.13 {TclCompileForCmd: long command body} {
2716 for {set i 1} {$i<6} {set i [expr $i+1]} {
2719 set tcl_platform(machine) i686
2720 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2721 catch {set a $a} msg
2722 catch {incr i 5} msg
2723 catch {incr i -5} msg
2725 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2726 catch {set a $a} msg
2727 catch {incr i 5} msg
2728 catch {incr i -5} msg
2730 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2731 catch {set a $a} msg
2732 catch {incr i 5} msg
2733 catch {incr i -5} msg
2735 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2736 catch {set a $a} msg
2737 catch {incr i 5} msg
2738 catch {incr i -5} msg
2740 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2741 catch {set a $a} msg
2742 catch {incr i 5} msg
2743 catch {incr i -5} msg
2745 set a [concat $a $i]
2749 test for-1.14 {TclCompileForCmd: for command result} {
2750 set a [for {set i 0} {$i < 5} {incr i} {}]
2753 test for-1.15 {TclCompileForCmd: for command result} {
2754 set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
2758 # Check "for" and "continue".
2760 test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
2761 catch {continue foo} msg
2763 } {wrong # args: should be "continue"}
2764 test for-2.2 {TclCompileContinueCmd: continue result} {
2767 test for-2.3 {continue tests} {
2769 for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2770 if {$i == 2} continue
2771 set a [concat $a $i]
2775 test for-2.4 {continue tests} {
2777 for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2778 if {$i != 2} continue
2779 set a [concat $a $i]
2783 test for-2.5 {continue tests, nested loops} {
2785 for {set i 1} {$i <= 4} {incr i} {
2786 for {set a 1} {$a <= 2} {incr a} {
2787 if {$i>=2 && $a>=2} continue
2788 set msg [concat $msg "$i.$a"]
2792 } {1.1 1.2 2.1 3.1 4.1}
2793 test for-2.6 {continue tests, long command body} {
2795 for {set i 1} {$i<6} {set i [expr $i+1]} {
2799 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2800 catch {set a $a} msg
2801 catch {incr i 5} msg
2802 catch {incr i -5} msg
2804 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2805 catch {set a $a} msg
2806 catch {incr i 5} msg
2807 catch {incr i -5} msg
2809 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2810 catch {set a $a} msg
2811 catch {incr i 5} msg
2812 catch {incr i -5} msg
2814 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2815 catch {set a $a} msg
2816 catch {incr i 5} msg
2817 catch {incr i -5} msg
2819 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2820 catch {set a $a} msg
2821 catch {incr i 5} msg
2822 catch {incr i -5} msg
2824 set a [concat $a $i]
2829 # Check "for" and "break".
2831 test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
2832 catch {break foo} msg
2834 } {wrong # args: should be "break"}
2835 test for-3.2 {TclCompileBreakCmd: break result} {
2838 test for-3.3 {break tests} {
2840 for {set i 1} {$i <= 4} {incr i} {
2842 set a [concat $a $i]
2846 test for-3.4 {break tests, nested loops} {
2848 for {set i 1} {$i <= 4} {incr i} {
2849 for {set a 1} {$a <= 2} {incr a} {
2850 if {$i>=2 && $a>=2} break
2851 set msg [concat $msg "$i.$a"]
2855 } {1.1 1.2 2.1 3.1 4.1}
2856 test for-3.5 {break tests, long command body} {
2858 for {set i 1} {$i<6} {set i [expr $i+1]} {
2862 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2863 catch {set a $a} msg
2864 catch {incr i 5} msg
2865 catch {incr i -5} msg
2867 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2868 catch {set a $a} msg
2869 catch {incr i 5} msg
2870 catch {incr i -5} msg
2872 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2873 catch {set a $a} msg
2874 catch {incr i 5} msg
2875 catch {incr i -5} msg
2878 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2879 catch {set a $a} msg
2880 catch {incr i 5} msg
2881 catch {incr i -5} msg
2883 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2884 catch {set a $a} msg
2885 catch {incr i 5} msg
2886 catch {incr i -5} msg
2888 set a [concat $a $i]
2892 test for-4.1 {break must reset the interp result} {
2894 set z GLOBTESTDIR/dir2/file2.c
2895 if [string match GLOBTESTDIR/dir2/* $z] {
2902 # Test for incorrect "double evaluation" semantics
2904 test for-5.1 {possible delayed substitution of increment command} {
2905 # Increment should be 5, and lappend should always append $a
2910 for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2914 test for-5.2 {possible delayed substitution of increment command} {
2915 # Increment should be 5, and lappend should always append $a
2920 for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2925 test for-5.3 {possible delayed substitution of body command} {
2926 # Increment should be $a, and lappend should always append 5
2929 for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2932 test for-5.4 {possible delayed substitution of body command} {
2933 # Increment should be $a, and lappend should always append 5
2938 for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2944 # In the following tests we need to bypass the bytecode compiler by
2945 # substituting the command from a variable. This ensures that command
2946 # procedure is invoked directly.
2948 test for-6.1 {Tcl_ForObjCmd: number of args} {
2952 } {wrong # args: should be "for start test next body"}
2953 test for-6.2 {Tcl_ForObjCmd: number of args} {
2955 catch {$z {set i 0}} msg
2957 } {wrong # args: should be "for start test next body"}
2958 test for-6.3 {Tcl_ForObjCmd: number of args} {
2960 catch {$z {set i 0} {$i < 5}} msg
2962 } {wrong # args: should be "for start test next body"}
2963 test for-6.4 {Tcl_ForObjCmd: number of args} {
2965 catch {$z {set i 0} {$i < 5} {incr i}} msg
2967 } {wrong # args: should be "for start test next body"}
2968 test for-6.5 {Tcl_ForObjCmd: number of args} {
2970 catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
2972 } {wrong # args: should be "for start test next body"}
2973 test for-6.6 {Tcl_ForObjCmd: error in initial command} {
2975 list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg
2976 } {1 {wrong # args: should be "set varName ?newValue?"}}
2977 test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
2980 $z {set i 6} "$i > 5" {incr i} {set y $i}
2983 test for-6.10 {Tcl_ForObjCmd: simple command body} {
2986 $z {set i 1} {$i<6} {set i [expr $i+1]} {
2988 set a [concat $a $i]
2992 test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
2995 $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2998 test for-6.12 {Tcl_ForObjCmd: computed command body} {
3003 set x1 {append a x1; }
3005 set x2 {; append a x2}
3007 $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
3010 test for-6.14 {Tcl_ForObjCmd: long command body} {
3013 $z {set i 1} {$i<6} {set i [expr $i+1]} {
3016 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3017 catch {set a $a} msg
3018 catch {incr i 5} msg
3019 catch {incr i -5} msg
3021 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3022 catch {set a $a} msg
3023 catch {incr i 5} msg
3024 catch {incr i -5} msg
3026 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3027 catch {set a $a} msg
3028 catch {incr i 5} msg
3029 catch {incr i -5} msg
3031 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3032 catch {set a $a} msg
3033 catch {incr i 5} msg
3034 catch {incr i -5} msg
3036 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3037 catch {set a $a} msg
3038 catch {incr i 5} msg
3039 catch {incr i -5} msg
3041 set a [concat $a $i]
3045 test for-6.15 {Tcl_ForObjCmd: for command result} {
3047 set a [$z {set i 0} {$i < 5} {incr i} {}]
3050 test for-6.16 {Tcl_ForObjCmd: for command result} {
3052 set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
3057 ################################################################################
3059 ################################################################################
3061 test info-1.1 {info body option} {
3062 proc t1 {} {body of t1}
3065 test info-1.2 {info body option} {
3066 list [catch {info body set} msg] $msg
3067 } {1 {command "set" is not a procedure}}
3068 test info-1.3 {info body option} {
3069 list [catch {info args set 1} msg] $msg
3070 } {1 {wrong # args: should be "info args procname"}}
3071 test info-1.5 {info body option, returning bytecompiled bodies} {
3076 return "variable $v existence: [info exists var]"
3080 list [catch [info body foo] msg] $msg
3081 } {1 {can't read "args": no such variable}}
3082 test info-1.6 {info body option, returning list bodies} {
3083 proc foo args [list subst bar]
3084 list [string length [info body foo]] \
3085 [foo; string length [info body foo]]
3087 test info-2.1 {info commands option} {
3090 set x " [info commands] "
3091 list [string match {* t1 *} $x] [string match {* t2 *} $x] \
3092 [string match {* set *} $x] [string match {* list *} $x]
3094 test info-2.2 {info commands option} {
3097 set x [info commands]
3098 string match {* t1 *} $x
3100 test info-2.3 {info commands option} {
3103 info commands _test1_
3105 test info-2.4 {info commands option} {
3108 lsort [info commands _test*]
3110 catch {rename _test1_ {}}
3111 catch {rename _test2_ {}}
3112 test info-2.5 {info commands option} {
3113 list [catch {info commands a b} msg] $msg
3114 } {1 {wrong # args: should be "info commands ?pattern?"}}
3115 test info-3.1 {info exists option} {
3119 catch {unset _nonexistent_}
3120 test info-3.2 {info exists option} {
3121 info exists _nonexistent_
3123 test info-3.3 {info exists option} {
3124 proc t1 {x} {return [info exists x]}
3127 test info-3.4 {info exists option} {
3129 global _nonexistent_
3130 return [info exists _nonexistent_]
3134 test info-3.5 {info exists option} {
3137 return [info exists y]
3141 test info-3.6 {info exists option} {
3142 proc t1 {x} {return [info exists value]}
3145 test info-3.7 {info exists option} {
3148 list [info exists x] [info exists x(1)] [info exists x(2)]
3151 test info-3.8 {info exists option} {
3152 list [catch {info exists} msg] $msg
3153 } {1 {wrong # args: should be "info exists varName"}}
3154 test info-3.9 {info exists option} {
3155 list [catch {info exists 1 2} msg] $msg
3156 } {1 {wrong # args: should be "info exists varName"}}
3157 test info-4.1 {info globals option} {
3161 set a " [info globals] "
3162 list [string match {* x *} $a] [string match {* y *} $a] \
3163 [string match {* value *} $a] [string match {* _foobar_ *} $a]
3165 test info-4.2 {info globals option} {
3168 lsort [info globals _xxx*]
3170 test info-4.3 {info globals option} {
3171 list [catch {info globals 1 2} msg] $msg
3172 } {1 {wrong # args: should be "info globals ?pattern?"}}
3173 test info-5.1 {info level option} {
3177 test info-5.2 {info level option} {
3180 set y [info level 1]
3184 } {1 {t1 146 testString}}
3185 test info-5.3 {info level option} {
3190 list [info level] [info level 1] [info level 2] [info level -1] \
3193 t1 146 {a {b c} {{{c}}}}
3194 } {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}
3195 test info-5.4 {info level option} {
3198 set y [info level 1]
3203 test info-5.5 {info level option} {
3204 list [catch {info level 1 2} msg] $msg
3205 } {1 {wrong # args: should be "info level ?levelNum?"}}
3206 test info-5.6 {info level option} {
3207 list [catch {info level 123a} msg] $msg
3208 } {1 {bad level "123a"}}
3209 test info-5.7 {info level option} {
3210 list [catch {info level 0} msg] $msg
3211 } {1 {bad level "0"}}
3212 test info-5.8 {info level option} {
3213 proc t1 {} {info level -1}
3214 list [catch {t1} msg] $msg
3215 } {1 {bad level "-1"}}
3216 test info-5.9 {info level option} {
3217 proc t1 {x} {info level $x}
3218 list [catch {t1 -3} msg] $msg
3219 } {1 {bad level "-3"}}
3220 test info-6.1 {info locals option} {
3228 return [info locals]
3232 test info-6.2 {info locals option} {
3237 return [info locals x*]
3241 test info-6.3 {info locals option} {
3242 list [catch {info locals 1 2} msg] $msg
3243 } {1 {wrong # args: should be "info locals ?pattern?"}}
3244 test info-6.4 {info locals option} {
3247 test info-6.5 {info locals option} {
3248 proc t1 {} {return [info locals]}
3251 test info-6.6 {info locals vs unset compiled locals} {
3253 foreach $lst $lst {}
3255 return [info locals]
3257 lsort [t1 {a b c c d e f}]
3259 test info-6.7 {info locals with temporary variables} {
3266 test info-7.1 {info vars option} {
3276 test info-7.2 {info vars option} {
3282 return [info vars x*]
3286 test info-7.3 {info vars option} {
3288 } [lsort [info globals]]
3289 test info-7.4 {info vars option} {
3290 list [catch {info vars a b} msg] $msg
3291 } {1 {wrong # args: should be "info vars ?pattern?"}}
3292 test info-7.5 {info vars with temporary variables} {
3300 ################################################################################
3302 ################################################################################
3304 test range-1.1 {basic range tests} {
3306 } {0 1 2 3 4 5 6 7 8 9}
3308 test range-1.2 {basic range tests} {
3310 } {10 9 8 7 6 5 4 3 2 1}
3312 test range-1.3 {basic range tests} {
3316 test range-1.4 {basic range tests} {
3320 test range-1.5 {basic range tests} {
3324 test range-1.6 {basic range tests} {
3328 test range-1.7 {basic range test} {
3332 test range-1.8 {basic range test} {
3334 } {-10 -12 -14 -16 -18}
3336 test range-1.9 {basic range test} {
3340 test range-2.0 {foreach range test} {
3342 foreach {x y} [range 100] {
3343 incr k [expr {$x*$y}]
3348 test range-2.1 {foreach range test without obj reuse} {
3351 foreach {x y} [range 100] {
3352 incr k [expr {$x*$y}]
3359 test range-2.2 {range element shimmering test} {
3361 foreach x [range 0 10] {
3362 append k [llength $x]
3367 test range-3.0 {llength range test} {
3368 llength [range 5000]
3371 test range-3.1 {llength range test} {
3372 llength [range 5000 5000]
3375 test range-4.0 {lindex range test} {
3376 lindex [range 1000] 500
3379 test range-4.1 {lindex range test} {
3380 lindex [range 1000] end-2
3383 test range-5.0 {lindex llength range test} {
3387 for {set i 0} {$i < [llength $r]} {incr i 2} {
3388 incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}]
3394 ################################################################################
3396 ################################################################################
3398 test scope-1.0 {Non existing var} {
3404 list [info exists x] $y
3407 test scope-1.1 {Existing var restore} {
3410 for {set x 0} {$x < 10} {incr x} {}
3415 test scope-1.2 {Mix of 1.0 and 1.1 tests} {
3422 list [info exists x] $y
3425 test scope-1.3 {Array element} {
3433 test scope-1.4 {Non existing array element} {
3441 test scope-1.5 {Info exists} {
3452 ################################################################################
3454 ################################################################################
3455 test rand-1.0 {Only one output is valid} {
3456 list [rand 100 100] [rand 101 101]
3459 test rand-1.1 {invalid arguments} {
3460 catch {rand 100 50} err
3462 } {Invalid arguments (max < min)}
3464 test rand-1.2 {Check limits} {
3466 for {set i 0} {$i < 100} {incr i} {
3467 incr sum [expr {([rand $i] >= 0)+([rand $i] < 100)}]
3472 catch {unset sum; unset err; unset i}
3474 ################################################################################
3475 # JIM REGRESSION TESTS
3476 ################################################################################
3477 test regression-1.0 {Rename against procedures with static vars} {
3478 proc foobar {x} {{y 10}} {
3483 rename foobar barfoo
3484 list [barfoo 1] [barfoo 2] [barfoo 3]
3487 catch {rename barfoo {}}
3489 test regression-1.1 {lrange bug with negative indexes of type int} {
3490 lrange {a b c} 0 [- 0 1]
3493 test regression-1.2 {open/close from non-global namespace} {
3495 set f [open $::argv0]
3501 expr {$f in [info channels]}
3504 test regression-1.3 {value of tcl_platform(engine)} {
3505 set ::tcl_platform(engine)