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 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 catch { unset lindex}
1838 catch { unset minus }
1840 ################################################################################
1842 ################################################################################
1847 # Basic "foreach" operation.
1849 test foreach-1.1 {basic foreach tests} {
1851 foreach i {a b c d} {
1852 set a [concat $a $i]
1856 test foreach-1.2 {basic foreach tests} {
1858 foreach i {a b {{c d} e} {123 {{x}}}} {
1859 set a [concat $a $i]
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} {
1870 set a [concat $a $i]
1875 test foreach-2.1 {foreach errors} {
1876 list [catch {foreach {} {} {}} msg] $msg
1877 } {1 {foreach varlist is empty}}
1880 test foreach-3.1 {parallel foreach tests} {
1882 foreach {a b} {1 2 3 4} {
1887 test foreach-3.2 {parallel foreach tests} {
1889 foreach {a b} {1 2 3 4 5} {
1894 test foreach-3.3 {parallel foreach tests} {
1896 foreach a {1 2 3} b {4 5 6} {
1901 test foreach-3.4 {parallel foreach tests} {
1903 foreach a {1 2 3} b {4 5 6 7 8} {
1908 test foreach-3.5 {parallel foreach tests} {
1910 foreach {a b} {a b A B aa bb} c {c C cc CC} {
1915 test foreach-3.6 {parallel foreach tests} {
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
1922 test foreach-3.7 {parallel foreach tests} {
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
1929 test foreach-4.1 {foreach only sets vars if repeating loop} {
1932 foreach {r g b} [set rgb] {}
1933 return "r=$r, g=$g, b=$b"
1936 } {r=65535, g=0, b=0}
1937 test foreach-5.1 {foreach supports dict syntactic sugar} {
1940 foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]}
1946 test foreach-6.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
1948 foreach {12.0} {a b c} {
1957 test foreach-7.1 {continue tests} {catch continue} 4
1958 test foreach-7.2 {continue tests} {
1960 foreach i {a b c d} {
1961 if {[string compare $i "b"] == 0} continue
1962 set a [concat $a $i]
1966 test foreach-7.3 {continue tests} {
1968 foreach i {a b c d} {
1969 if {[string compare $i "b"] != 0} continue
1970 set a [concat $a $i]
1974 test foreach-7.4 {continue tests} {catch {continue foo} msg} 1
1975 test foreach-7.5 {continue tests} {
1976 catch {continue foo} msg
1978 } {wrong # args: should be "continue"}
1982 test foreach-8.1 {break tests} {catch break} 3
1983 test foreach-8.2 {break tests} {
1985 foreach i {a b c d} {
1986 if {[string compare $i "c"] == 0} break
1987 set a [concat $a $i]
1991 test foreach-8.3 {break tests} {catch {break foo} msg} 1
1992 test foreach-8.4 {break tests} {
1993 catch {break foo} msg
1995 } {wrong # args: should be "break"}
1997 # Test for incorrect "double evaluation" semantics
1999 test foreach-9.1 {delayed substitution of body - knownbugs} {
2002 foreach a [list 1 2 3] "
2014 ################################################################################
2016 ################################################################################
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
2031 test string-7.13 {string last, start index} {
2032 ## Constrain to last 'a' should work
2033 string last ba badbad end-1
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
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}
2054 #test string-11.4 {string match} {
2055 # proc foo {} {string mat abc abd}
2058 test string-11.5 {string match} {
2059 proc foo {} {string match ab*c abc}
2062 test string-11.6 {string match} {
2063 proc foo {} {string match ab**c abc}
2066 test string-11.7 {string match} {
2067 proc foo {} {string match ab* abcdef}
2070 test string-11.8 {string match} {
2071 proc foo {} {string match *c abc}
2074 test string-11.9 {string match} {
2075 proc foo {} {string match *3*6*9 0123456789}
2078 test string-11.10 {string match} {
2079 proc foo {} {string match *3*6*9 01234567890}
2082 test string-11.11 {string match} {
2083 proc foo {} {string match a?c abc}
2086 test string-11.12 {string match} {
2087 proc foo {} {string match a??c abc}
2090 test string-11.13 {string match} {
2091 proc foo {} {string match ?1??4???8? 0123456789}
2094 test string-11.14 {string match} {
2095 proc foo {} {string match {[abc]bc} abc}
2098 test string-11.15 {string match} {
2099 proc foo {} {string match {a[abc]c} abc}
2102 test string-11.16 {string match} {
2103 proc foo {} {string match {a[xyz]c} abc}
2106 test string-11.17 {string match} {
2107 proc foo {} {string match {12[2-7]45} 12345}
2110 test string-11.18 {string match} {
2111 proc foo {} {string match {12[ab2-4cd]45} 12345}
2114 test string-11.19 {string match} {
2115 proc foo {} {string match {12[ab2-4cd]45} 12b45}
2118 test string-11.20 {string match} {
2119 proc foo {} {string match {12[ab2-4cd]45} 12d45}
2122 test string-11.21 {string match} {
2123 proc foo {} {string match {12[ab2-4cd]45} 12145}
2126 test string-11.22 {string match} {
2127 proc foo {} {string match {12[ab2-4cd]45} 12545}
2130 test string-11.23 {string match} {
2131 proc foo {} {string match {a\*b} a*b}
2134 test string-11.24 {string match} {
2135 proc foo {} {string match {a\*b} ab}
2138 test string-11.25 {string match} {
2139 proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
2142 test string-11.26 {string match} {
2143 proc foo {} {string match ** ""}
2146 test string-11.27 {string match} {
2147 proc foo {} {string match *. ""}
2150 test string-11.28 {string match} {
2151 proc foo {} {string match "" ""}
2154 test string-11.29 {string match} {
2155 proc foo {} {string match \[a a}
2158 test string-11.31 {string match case} {
2159 proc foo {} {string match a A}
2162 test string-11.32 {string match nocase} {
2163 proc foo {} {string match -n a A}
2166 #test string-11.33 {string match nocase} {
2167 # proc foo {} {string match -nocase a\334 A\374}
2170 test string-11.34 {string match nocase} {
2171 proc foo {} {string match -nocase a*f ABCDEf}
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]} _}
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]} _}
2185 test string-11.37 {string match nocase} {
2186 proc foo {} {string match -nocase {[A-fh-Z]} g}
2189 test string-11.38 {string match case, reverse range} {
2190 proc foo {} {string match {[A-fh-Z]} g}
2193 test string-11.39 {string match, *\ case} {
2194 proc foo {} {string match {*\abc} abc}
2197 test string-11.40 {string match, *special case} {
2198 proc foo {} {string match {*[ab]} abc}
2201 test string-11.41 {string match, *special case} {
2202 proc foo {} {string match {*[ab]*} abc}
2205 #test string-11.42 {string match, *special case} {
2206 # proc foo {} {string match "*\\" "\\"}
2209 test string-11.43 {string match, *special case} {
2210 proc foo {} {string match "*\\\\" "\\"}
2213 test string-11.44 {string match, *special case} {
2214 proc foo {} {string match "*???" "12345"}
2217 test string-11.45 {string match, *special case} {
2218 proc foo {} {string match "*???" "12"}
2221 test string-11.46 {string match, *special case} {
2222 proc foo {} {string match "*\\*" "abc*"}
2225 test string-11.47 {string match, *special case} {
2226 proc foo {} {string match "*\\*" "*"}
2229 test string-11.48 {string match, *special case} {
2230 proc foo {} {string match "*\\*" "*abc"}
2233 test string-11.49 {string match, *special case} {
2234 proc foo {} {string match "?\\*" "a*"}
2237 #test string-11.50 {string match, *special case} {
2238 # proc foo {} {string match "\\" "\\"}
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"}
2259 test string-10.4 {string map} {
2260 string map {a b} abba
2262 test string-10.5 {string map} {
2265 test string-10.6 {string map -nocase} {
2266 string map -nocase {a b} Abba
2268 test string-10.7 {string map} {
2269 string map {abc 321 ab * a A} aabcabaababcab
2271 test string-10.8 {string map -nocase} {
2272 string map -nocase {aBc 321 Ab * a A} aabcabaababcab
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}
2280 test string-10.12 {string map, unicode} {
2281 string map [list \u00fc ue UE \u00dc] "a\u00fcueUE\000EU"
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
2289 test string-10.15 {string map, one pair case} {
2290 string map -nocase {abc 32} aAbCaBaAbAbcAb
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
2301 test string-10.19 {string map, empty arguments} {
2302 string map -nocase {{} abc f bar {} def} foo
2305 ################################################################################
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} {
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} {
2324 test split-1.6 {basic split commands} {
2327 test split-1.7 {basic split commands} {
2330 test split-1.8 {basic split commands} {
2333 foreach f [split {]\n} {}] {
2340 test split-1.9 {basic split commands} {
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} {
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," {,}
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?"}}
2372 catch {rename foo {}}
2374 ################################################################################
2376 ################################################################################
2378 test join-1.1 {basic join commands} {
2381 test join-1.2 {basic join commands} {
2384 test join-1.3 {basic join commands} {
2387 test join-1.4 {basic join commands} {
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]
2405 test join-3.2 {join is binary ok} {
2406 string length [join "a\0b a\0b a\0b"]
2409 ################################################################################
2411 ################################################################################
2413 test switch-1.1 {simple patterns} {
2414 switch a a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2416 test switch-1.2 {simple patterns} {
2417 switch b a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2419 test switch-1.3 {simple patterns} {
2420 switch x a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2422 test switch-1.4 {simple patterns} {
2423 switch x a {expr 1} b {expr 2} c {expr 3}
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}
2428 test switch-1.6 {simple patterns} {
2429 switch default a {expr 1} default {expr 2} c {expr 3} default {expr 4}
2431 test switch-1.7 {simple patterns} {
2432 switch x a {expr 1} default {expr 2} c {expr 3} default {expr 4}
2435 test switch-2.1 {single-argument form for pattern/command pairs} {
2442 test switch-2.2 {single-argument form for pattern/command pairs} {
2443 list [catch {switch z {a 2 b}}]
2446 test switch-3.1 {-exact vs. -glob vs. -regexp} {
2447 switch -exact aaaab {
2448 ^a*b$ {concat regexp}
2450 aaaab {concat exact}
2451 default {concat none}
2454 test switch-3.2 {-exact vs. -glob vs. -regexp (no [regexp] cmd)} regexp {
2455 rename regexp regexp.none
2457 switch -regexp aaaab {
2458 ^a*b$ {concat regexp}
2460 aaaab {concat exact}
2461 default {concat none}
2464 rename regexp.none regexp
2468 test switch-3.3 {-exact vs. -glob vs. -regexp (with [regexp] cmd)} regexp {
2469 switch -regexp aaaab {
2470 ^a*b$ {concat regexp}
2472 aaaab {concat exact}
2473 default {concat none}
2476 test switch-3.4 {-exact vs. -glob vs. -regexp} {
2477 switch -glob aaaab {
2478 ^a*b$ {concat regexp}
2480 aaaab {concat exact}
2481 default {concat none}
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}
2488 test switch-3.6 {-exact vs. -glob vs. -regexp} {
2490 ^g.*b$ {concat regexp}
2492 -glob {concat exact}
2493 default {concat none}
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] \
2504 test switch-4.2 {error: not enough args} {
2507 test switch-4.3 {error: pattern with no body} {
2510 test switch-4.4 {error: pattern with no body} {
2511 catch {switch a b {expr 1} c}
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
2518 test switch-5.1 {errors in -regexp matching} regexp {
2519 catch {switch -regexp aaaab {
2521 aaaab {concat exact}
2522 default {concat none}
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}
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}
2545 test switch-7.1 {"-" bodies} {
2553 test switch-7.2 {"-" bodies} {
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} {
2571 #~ } {1 {no body specified for pattern "c"}}
2572 test switch-7.3 {"-" bodies} {
2580 } {1 {invalid command name "-foo"}}
2582 test switch-8.1 {empty body} {
2591 test switch-9.1 {empty pattern/body list} {
2594 test switch-9.2 {empty pattern/body list} {
2597 test switch-9.3 {empty pattern/body list} {
2600 test switch-9.4 {empty pattern/body list} {
2601 catch {switch -- x {}}
2603 test switch-9.5 {unpaired pattern} {
2604 catch {switch x a {} b}
2606 test switch-9.6 {unpaired pattern} {
2607 catch {switch x {a {} b}}
2609 test switch-9.7 {unpaired pattern} {
2610 catch {switch x a {} # comment b}
2612 test switch-9.8 {unpaired pattern} {
2613 catch {switch x {a {} # comment b}}
2615 test switch-9.9 {unpaired pattern} {
2616 catch {switch x a {} x {} # comment b}
2618 test switch-9.10 {unpaired pattern} {
2619 catch {switch x {a {} x {} # comment b}}
2622 test switch-10.1 {no callback given to -command} {
2623 catch {switch -command a { a {expr 1} b {expr 2} }}
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} }}
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}
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}
2634 test switch-10.5 {[error] in callback to -command} lambda {
2636 switch -command [lambda {p1 p2} {error "foo"}] a a {expr 1} b {expr 2}
2639 test switch-10.6 {[continue] in callback to -command} lambda {
2641 switch -command [lambda {p1 p2} {continue}] a a {expr 1} b {expr 2}
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}
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}
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}
2657 ################################################################################
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"}}
2669 test for-1.3 {TclCompileForCmd: missing test expression} {
2670 catch {for {set i 0}} msg
2672 } {wrong # args: should be "for start test next body"}
2673 test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
2675 for {} "$i > 5" {incr i} {}
2677 test for-1.6 {TclCompileForCmd: missing "next" command} {
2678 catch {for {set i 0} {$i < 5}} 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
2684 } {wrong # args: should be "for start test next body"}
2686 test for-1.9 {TclCompileForCmd: simple command body} {
2688 for {set i 1} {$i<6} {set i [expr $i+1]} {
2690 set a [concat $a $i]
2694 test for-1.10 {TclCompileForCmd: command body in quotes} {
2696 for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2699 test for-1.11 {TclCompileForCmd: computed command body} {
2703 set x1 {append a x1; }
2705 set x2 {; append a x2}
2707 for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
2710 test for-1.13 {TclCompileForCmd: long command body} {
2712 for {set i 1} {$i<6} {set i [expr $i+1]} {
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
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
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
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
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
2741 set a [concat $a $i]
2745 test for-1.14 {TclCompileForCmd: for command result} {
2746 set a [for {set i 0} {$i < 5} {incr i} {}]
2749 test for-1.15 {TclCompileForCmd: for command result} {
2750 set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
2754 # Check "for" and "continue".
2756 test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
2757 catch {continue foo} msg
2759 } {wrong # args: should be "continue"}
2760 test for-2.2 {TclCompileContinueCmd: continue result} {
2763 test for-2.3 {continue tests} {
2765 for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2766 if {$i == 2} continue
2767 set a [concat $a $i]
2771 test for-2.4 {continue tests} {
2773 for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2774 if {$i != 2} continue
2775 set a [concat $a $i]
2779 test for-2.5 {continue tests, nested loops} {
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"]
2788 } {1.1 1.2 2.1 3.1 4.1}
2789 test for-2.6 {continue tests, long command body} {
2791 for {set i 1} {$i<6} {set i [expr $i+1]} {
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
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
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
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
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
2820 set a [concat $a $i]
2825 # Check "for" and "break".
2827 test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
2828 catch {break foo} msg
2830 } {wrong # args: should be "break"}
2831 test for-3.2 {TclCompileBreakCmd: break result} {
2834 test for-3.3 {break tests} {
2836 for {set i 1} {$i <= 4} {incr i} {
2838 set a [concat $a $i]
2842 test for-3.4 {break tests, nested loops} {
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"]
2851 } {1.1 1.2 2.1 3.1 4.1}
2852 test for-3.5 {break tests, long command body} {
2854 for {set i 1} {$i<6} {set i [expr $i+1]} {
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
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
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
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
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
2884 set a [concat $a $i]
2888 test for-4.1 {break must reset the interp result} {
2890 set z GLOBTESTDIR/dir2/file2.c
2891 if [string match GLOBTESTDIR/dir2/* $z] {
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
2906 for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2910 test for-5.2 {possible delayed substitution of increment command} {
2911 # Increment should be 5, and lappend should always append $a
2916 for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2921 test for-5.3 {possible delayed substitution of body command} {
2922 # Increment should be $a, and lappend should always append 5
2925 for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2928 test for-5.4 {possible delayed substitution of body command} {
2929 # Increment should be $a, and lappend should always append 5
2934 for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
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} {
2948 } {wrong # args: should be "for start test next body"}
2949 test for-6.2 {Tcl_ForObjCmd: number of args} {
2951 catch {$z {set i 0}} msg
2953 } {wrong # args: should be "for start test next body"}
2954 test for-6.3 {Tcl_ForObjCmd: number of args} {
2956 catch {$z {set i 0} {$i < 5}} msg
2958 } {wrong # args: should be "for start test next body"}
2959 test for-6.4 {Tcl_ForObjCmd: number of args} {
2961 catch {$z {set i 0} {$i < 5} {incr i}} msg
2963 } {wrong # args: should be "for start test next body"}
2964 test for-6.5 {Tcl_ForObjCmd: number of args} {
2966 catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
2968 } {wrong # args: should be "for start test next body"}
2969 test for-6.6 {Tcl_ForObjCmd: error in initial command} {
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} {
2976 $z {set i 6} "$i > 5" {incr i} {set y $i}
2979 test for-6.10 {Tcl_ForObjCmd: simple command body} {
2982 $z {set i 1} {$i<6} {set i [expr $i+1]} {
2984 set a [concat $a $i]
2988 test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
2991 $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2994 test for-6.12 {Tcl_ForObjCmd: computed command body} {
2999 set x1 {append a x1; }
3001 set x2 {; append a x2}
3003 $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
3006 test for-6.14 {Tcl_ForObjCmd: long command body} {
3009 $z {set i 1} {$i<6} {set i [expr $i+1]} {
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
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
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
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
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
3037 set a [concat $a $i]
3041 test for-6.15 {Tcl_ForObjCmd: for command result} {
3043 set a [$z {set i 0} {$i < 5} {incr i} {}]
3046 test for-6.16 {Tcl_ForObjCmd: for command result} {
3048 set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
3053 ################################################################################
3055 ################################################################################
3057 test info-1.1 {info body option} {
3058 proc t1 {} {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} {
3072 return "variable $v existence: [info exists var]"
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]]
3083 test info-2.1 {info commands option} {
3086 set x " [info commands] "
3087 list [string match {* t1 *} $x] [string match {* t2 *} $x] \
3088 [string match {* set *} $x] [string match {* list *} $x]
3090 test info-2.2 {info commands option} {
3093 set x [info commands]
3094 string match {* t1 *} $x
3096 test info-2.3 {info commands option} {
3099 info commands _test1_
3101 test info-2.4 {info commands option} {
3104 lsort [info commands _test*]
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} {
3115 catch {unset _nonexistent_}
3116 test info-3.2 {info exists option} {
3117 info exists _nonexistent_
3119 test info-3.3 {info exists option} {
3120 proc t1 {x} {return [info exists x]}
3123 test info-3.4 {info exists option} {
3125 global _nonexistent_
3126 return [info exists _nonexistent_]
3130 test info-3.5 {info exists option} {
3133 return [info exists y]
3137 test info-3.6 {info exists option} {
3138 proc t1 {x} {return [info exists value]}
3141 test info-3.7 {info exists option} {
3144 list [info exists x] [info exists x(1)] [info exists x(2)]
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} {
3157 set a " [info globals] "
3158 list [string match {* x *} $a] [string match {* y *} $a] \
3159 [string match {* value *} $a] [string match {* _foobar_ *} $a]
3161 test info-4.2 {info globals option} {
3164 lsort [info globals _xxx*]
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} {
3173 test info-5.2 {info level option} {
3176 set y [info level 1]
3180 } {1 {t1 146 testString}}
3181 test info-5.3 {info level option} {
3186 list [info level] [info level 1] [info level 2] [info level -1] \
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} {
3194 set y [info level 1]
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} {
3224 return [info locals]
3228 test info-6.2 {info locals option} {
3233 return [info locals x*]
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} {
3243 test info-6.5 {info locals option} {
3244 proc t1 {} {return [info locals]}
3247 test info-6.6 {info locals vs unset compiled locals} {
3249 foreach $lst $lst {}
3251 return [info locals]
3253 lsort [t1 {a b c c d e f}]
3255 test info-6.7 {info locals with temporary variables} {
3262 test info-7.1 {info vars option} {
3272 test info-7.2 {info vars option} {
3278 return [info vars x*]
3282 test info-7.3 {info vars option} {
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} {
3296 ################################################################################
3298 ################################################################################
3300 test range-1.1 {basic range tests} {
3302 } {0 1 2 3 4 5 6 7 8 9}
3304 test range-1.2 {basic range tests} {
3306 } {10 9 8 7 6 5 4 3 2 1}
3308 test range-1.3 {basic range tests} {
3312 test range-1.4 {basic range tests} {
3316 test range-1.5 {basic range tests} {
3320 test range-1.6 {basic range tests} {
3324 test range-1.7 {basic range test} {
3328 test range-1.8 {basic range test} {
3330 } {-10 -12 -14 -16 -18}
3332 test range-1.9 {basic range test} {
3336 test range-2.0 {foreach range test} {
3338 foreach {x y} [range 100] {
3339 incr k [expr {$x*$y}]
3344 test range-2.1 {foreach range test without obj reuse} {
3347 foreach {x y} [range 100] {
3348 incr k [expr {$x*$y}]
3355 test range-2.2 {range element shimmering test} {
3357 foreach x [range 0 10] {
3358 append k [llength $x]
3363 test range-3.0 {llength range test} {
3364 llength [range 5000]
3367 test range-3.1 {llength range test} {
3368 llength [range 5000 5000]
3371 test range-4.0 {lindex range test} {
3372 lindex [range 1000] 500
3375 test range-4.1 {lindex range test} {
3376 lindex [range 1000] end-2
3379 test range-5.0 {lindex llength range test} {
3383 for {set i 0} {$i < [llength $r]} {incr i 2} {
3384 incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}]
3390 ################################################################################
3392 ################################################################################
3394 test scope-1.0 {Non existing var} {
3400 list [info exists x] $y
3403 test scope-1.1 {Existing var restore} {
3406 for {set x 0} {$x < 10} {incr x} {}
3411 test scope-1.2 {Mix of 1.0 and 1.1 tests} {
3418 list [info exists x] $y
3421 test scope-1.3 {Array element} {
3429 test scope-1.4 {Non existing array element} {
3437 test scope-1.5 {Info exists} {
3448 ################################################################################
3450 ################################################################################
3451 test rand-1.0 {Only one output is valid} {
3452 list [rand 100 100] [rand 101 101]
3455 test rand-1.1 {invalid arguments} {
3456 catch {rand 100 50} err
3458 } {Invalid arguments (max < min)}
3460 test rand-1.2 {Check limits} {
3462 for {set i 0} {$i < 100} {incr i} {
3463 incr sum [expr {([rand $i] >= 0)+([rand $i] < 100)}]
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}} {
3479 rename foobar barfoo
3480 list [barfoo 1] [barfoo 2] [barfoo 3]
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]
3489 test regression-1.2 {open/close from non-global namespace} {
3491 set f [open $::argv0]
3497 expr {$f in [info channels]}