1 # $Id: test.tcl,v 1.31 2008/11/06 13:31:22 oharboe Exp $
3 # This 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.
14 proc test
{id descr script expectedResult
} {
15 global failedTests failedList passedTests
17 puts -nonewline "$id $descr: "
18 set rc
[catch [list uplevel 1 $script] result
]
19 if {$rc == 0 && $result eq
$expectedResult} {
24 puts "Expected: '$expectedResult'"
25 puts "Got : '$result'"
27 lappend failedList
$id
31 catch {package require
regexp}
33 if {[info commands
regexp] eq
""} {
34 proc regexp {pat str
} {expr {$pat eq
"^a*b$" && $str eq
"aaaab"}}
37 ################################################################################
39 ################################################################################
41 test set-1.2
{TclCompileSetCmd
: simple
variable name
} {
46 test set-1.4
{TclCompileSetCmd
: simple
variable name in quotes
} {
51 test set-1.7
{TclCompileSetCmd
: non-simple
(computed
) variable name
} {
57 test set-1.8
{TclCompileSetCmd
: non-simple
(computed
) variable name
} {
60 list [set [set x
] 2] $i
63 test set-1.9
{TclCompileSetCmd
: 3rd arg
=> assignment
} {
68 test set-1.10
{TclCompileSetCmd
: only two args
=> just getting value
} {
73 test set-1.11
{TclCompileSetCmd
: simple
global name
} {
82 test set-1.12
{TclCompileSetCmd
: simple local name
} {
90 test set-1.14
{TclCompileSetCmd
: simple local name
, >255 locals
} {
92 # create 260 locals (the last ones with index > 255)
93 set a0
0; set a1
0; set a2
0; set a3
0; set a4
0
94 set a5
0; set a6
0; set a7
0; set a8
0; set a9
0
95 set b0
0; set b1
0; set b2
0; set b3
0; set b4
0
96 set b5
0; set b6
0; set b7
0; set b8
0; set b9
0
97 set c0
0; set c1
0; set c2
0; set c3
0; set c4
0
98 set c5
0; set c6
0; set c7
0; set c8
0; set c9
0
99 set d0
0; set d1
0; set d2
0; set d3
0; set d4
0
100 set d5
0; set d6
0; set d7
0; set d8
0; set d9
0
101 set e0
0; set e1
0; set e2
0; set e3
0; set e4
0
102 set e5
0; set e6
0; set e7
0; set e8
0; set e9
0
103 set f0
0; set f1
0; set f2
0; set f3
0; set f4
0
104 set f5
0; set f6
0; set f7
0; set f8
0; set f9
0
105 set g0
0; set g1
0; set g2
0; set g3
0; set g4
0
106 set g5
0; set g6
0; set g7
0; set g8
0; set g9
0
107 set h0
0; set h1
0; set h2
0; set h3
0; set h4
0
108 set h5
0; set h6
0; set h7
0; set h8
0; set h9
0
109 set i0
0; set i1
0; set i2
0; set i3
0; set i4
0
110 set i5
0; set i6
0; set i7
0; set i8
0; set i9
0
111 set j0
0; set j1
0; set j2
0; set j3
0; set j4
0
112 set j5
0; set j6
0; set j7
0; set j8
0; set j9
0
113 set k0
0; set k1
0; set k2
0; set k3
0; set k4
0
114 set k5
0; set k6
0; set k7
0; set k8
0; set k9
0
115 set l0
0; set l1
0; set l2
0; set l3
0; set l4
0
116 set l5
0; set l6
0; set l7
0; set l8
0; set l9
0
117 set m0
0; set m1
0; set m2
0; set m3
0; set m4
0
118 set m5
0; set m6
0; set m7
0; set m8
0; set m9
0
119 set n0
0; set n1
0; set n2
0; set n3
0; set n4
0
120 set n5
0; set n6
0; set n7
0; set n8
0; set n9
0
121 set o0
0; set o1
0; set o2
0; set o3
0; set o4
0
122 set o5
0; set o6
0; set o7
0; set o8
0; set o9
0
123 set p0
0; set p1
0; set p2
0; set p3
0; set p4
0
124 set p5
0; set p6
0; set p7
0; set p8
0; set p9
0
125 set q0
0; set q1
0; set q2
0; set q3
0; set q4
0
126 set q5
0; set q6
0; set q7
0; set q8
0; set q9
0
127 set r0
0; set r1
0; set r2
0; set r3
0; set r4
0
128 set r5
0; set r6
0; set r7
0; set r8
0; set r9
0
129 set s0
0; set s1
0; set s2
0; set s3
0; set s4
0
130 set s5
0; set s6
0; set s7
0; set s8
0; set s9
0
131 set t0
0; set t1
0; set t2
0; set t3
0; set t4
0
132 set t5
0; set t6
0; set t7
0; set t8
0; set t9
0
133 set u0
0; set u1
0; set u2
0; set u3
0; set u4
0
134 set u5
0; set u6
0; set u7
0; set u8
0; set u9
0
135 set v0
0; set v1
0; set v2
0; set v3
0; set v4
0
136 set v5
0; set v6
0; set v7
0; set v8
0; set v9
0
137 set w0
0; set w1
0; set w2
0; set w3
0; set w4
0
138 set w5
0; set w6
0; set w7
0; set w8
0; set w9
0
139 set x0
0; set x1
0; set x2
0; set x3
0; set x4
0
140 set x5
0; set x6
0; set x7
0; set x8
0; set x9
0
141 set y0
0; set y1
0; set y2
0; set y3
0; set y4
0
142 set y5
0; set y6
0; set y7
0; set y8
0; set y9
0
143 set z0
0; set z1
0; set z2
0; set z3
0; set z4
0
144 set z5
0; set z6
0; set z7
0; set z8
0; set z9
1234
149 test set-1.17
{TclCompileSetCmd
: doing assignment
, simple int
} {
154 test set-1.18
{TclCompileSetCmd
: doing assignment
, simple int
} {
159 test set-1.19
{TclCompileSetCmd
: doing assignment
, simple but not int
} {
165 test set-1.20
{TclCompileSetCmd
: doing assignment
, in quotes
} {
170 test set-1.21
{TclCompileSetCmd
: doing assignment
, in braces
} {
175 test set-1.22
{TclCompileSetCmd
: doing assignment
, large int
} {
180 test set-1.23
{TclCompileSetCmd
: doing assignment
, formatted int
!= int
} {
182 set i
000012345 ;# an octal literal == 5349 decimal
186 ################################################################################
188 ################################################################################
190 test list-1.1
{basic tests
} {list a b c
} {a b c
}
191 test list-1.2
{basic tests
} {list {a b
} c
} {{a b
} c
}
192 test list-1.3
{basic tests
} {list \{a b c
} {\{a b c
}
193 test list-1.4
{basic tests
} "list a{}} b{} c}" "a\\{\\}\\} b{} c\\}"
194 test list-1.5
{basic tests
} {list a
\[ b
\] } "{a\[} b\\]"
195 test list-1.6
{basic tests
} {list c
\ d
\t } "{c } {d\t}"
196 test list-1.7
{basic tests
} {list e
\n f
\$ } "{e\n} {f\$}"
197 test list-1.8
{basic tests
} {list g
\; h
\\} {{g
;} h
\\}
198 test list-1.9
{basic tests
} "list a\\\[} b\\\]} " "a\\\[\\\} b\\\]\\\}"
199 test list-1.10
{basic tests
} "list c\\\} d\\t} " "c\\} d\\t\\}"
200 test list-1.11
{basic tests
} "list e\\n} f\\$} " "e\\n\\} f\\$\\}"
201 test list-1.12
{basic tests
} "list g\\;} h\\\\} " "g\\;\\} {h\\}}"
202 test list-1.13
{basic tests
} {list a
{{}} b
} {a
{{}} b
}
203 test list-1.14
{basic tests
} {list a b xy
\\} "a b xy\\\\"
204 test list-1.15
{basic tests
} "list a b\} e\\" "a b\\} e\\\\"
205 test list-1.16
{basic tests
} "list a b\}\\\$ e\\\$\\" "a b\\}\\\$ e\\\$\\\\"
206 test list-1.17
{basic tests
} {list a
\f \{\f} "{a\f} \\\{\\f"
207 test list-1.18
{basic tests
} {list a
\r \{\r} "{a\r} \\\{\\r"
208 test list-1.19
{basic tests
} {list a
\v \{\v} "{a\v} \\\{\\v"
209 test list-1.20
{basic tests
} {list \"\}\{} "\\\"\\}\\{"
210 test list-1.21
{basic tests
} {list a b c
\\\nd
} "a b c\\\\\\nd"
211 test list-1.22
{basic tests
} {list "{ab}\\"} \\{ab
\\}\\\\
212 test list-1.23
{basic tests
} {list \{} "\\{"
213 test list-1.24
{basic tests
} {list} {}
216 proc lcheck
{testid a b c
} {
218 set d
[list $a $b $c]
219 test
${testid
}-0 {what goes in must come out
} {lindex $d 0} $a
220 test
${testid
}-1 {what goes in must come out
} {lindex $d 1} $b
221 test
${testid
}-2 {what goes in must come out
} {lindex $d 2} $c
223 lcheck list-2.1 a b c
224 lcheck list-2.2
"a b" c
\td e
\nf
225 lcheck list-2.3
{{a b
}} {} { }
226 lcheck list-2.4
\$ \$ab ab
\$
227 lcheck list-2.5
\; \;ab ab
\;
228 lcheck list-2.6
\[ \[ab ab
\[
229 lcheck list-2.7
\\ \\ab ab
\\
230 lcheck list-2.8
{"} {"ab
} {ab
"} ;#" Stupid emacs highlighting
!
231 lcheck list-2.9
{a b
} { ab
} {ab
}
232 lcheck list-2.10 a
{ a
{b
\{ab
233 lcheck list-2.11 a
} a
}b
}ab
234 lcheck list-2.12 a
\\} {a
\}b
} {a
\{c
}
235 lcheck list-2.13 xyz
\\ 1\\\n2
236 lcheck list-2.14
"{ab}\\" "{ab}xy" abc
240 ################################################################################
242 ################################################################################
244 test while-1.9
{TclCompileWhileCmd
: simple command body
} {
255 test while-1.10
{TclCompileWhileCmd
: command body in quotes
} {
258 while {$i<6} "append a x; incr i"
262 test while-1.13
{TclCompileWhileCmd
: while command result
} {
264 set a
[while {$i < 5} {incr i
}]
268 test while-1.14
{TclCompileWhileCmd
: while command result
} {
270 set a
[while {$i < 5} {if $i==3 break; incr i
}]
274 test while-2.1
{continue tests
} {
279 if {$i == 3} continue
284 test while-2.2
{continue tests
} {
289 if {$i != 2} continue
294 test while-2.3
{continue tests
, nested loops
} {
302 if {$i>=3 && $a>=3} continue
303 set msg
[concat $msg "$i.$a"]
307 } {2.2 2.3 3.2 4.2 5.2}
309 test while-4.1
{while and computed command names
} {
318 test while-5.2
{break tests with computed command names
} {
330 test while-7.1
{delayed substitution of body
} {
332 while {[incr i
] < 10} "
337 while {[incr i
] < 10} "
345 ################################################################################
347 ################################################################################
351 test lset-2.1
{lset, not compiled
, 3 args
, second arg a plain index
} {
353 list [eval [list $lset x
0 3]] $x
356 test lset-3.1
{lset, not compiled
, 3 args
, data duplicated
} {
358 list [eval [list $lset x
0 $x]] $x
359 } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
361 test lset-3.2
{lset, not compiled
, 3 args
, data duplicated
} {
364 list [eval [list $lset x
0 2]] $x $y
365 } {{2 1} {2 1} {0 1}}
367 test lset-3.3
{lset, not compiled
, 3 args
, data duplicated
} {
370 list [eval [list $lset x
0 $x]] $x $y
371 } {{{0 1} 1} {{0 1} 1} {0 1}}
373 test lset-3.4
{lset, not compiled
, 3 args
, data duplicated
} {
375 list [eval [list $lset x
[list 0] $x]] $x
376 } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
378 test lset-3.5
{lset, not compiled
, 3 args
, data duplicated
} {
381 list [eval [list $lset x
[list 0] 2]] $x $y
382 } {{2 1} {2 1} {0 1}}
384 test lset-3.6
{lset, not compiled
, 3 args
, data duplicated
} {
387 list [eval [list $lset x
[list 0] $x]] $x $y
388 } {{{0 1} 1} {{0 1} 1} {0 1}}
390 test lset-4.2
{lset, not compiled
, 3 args
, bad index
} {
393 eval [list $lset a
[list 2a2
] w
]
395 } {1 {bad index
"2a2": must be integer?
[+-]integer? or end?
[+-]integer?
}}
397 test lset-4.3
{lset, not compiled
, 3 args
, index out of range
} {
400 eval [list $lset a
[list -1] w
]
402 } {1 {list index out of range
}}
404 test lset-4.4
{lset, not compiled
, 3 args
, index out of range
} {
407 eval [list $lset a
[list 3] w
]
409 } {1 {list index out of range
}}
411 test lset-4.5
{lset, not compiled
, 3 args
, index out of range
} {
414 eval [list $lset a
[list end--1
] w
]
416 } {1 {list index out of range
}}
418 test lset-4.6
{lset, not compiled
, 3 args
, index out of range
} {
421 eval [list $lset a
[list end-3
] w
]
423 } {1 {list index out of range
}}
425 test lset-4.8
{lset, not compiled
, 3 args
, bad index
} {
428 eval [list $lset a
2a2 w
]
430 } {1 {bad index
"2a2": must be integer?
[+-]integer? or end?
[+-]integer?
}}
432 test lset-4.9
{lset, not compiled
, 3 args
, index out of range
} {
435 eval [list $lset a
-1 w
]
437 } {1 {list index out of range
}}
439 test lset-4.10
{lset, not compiled
, 3 args
, index out of range
} {
442 eval [list $lset a
3 w
]
444 } {1 {list index out of range
}}
446 test lset-4.11
{lset, not compiled
, 3 args
, index out of range
} {
449 eval [list $lset a end--1 w
]
451 } {1 {list index out of range
}}
453 test lset-4.12
{lset, not compiled
, 3 args
, index out of range
} {
456 eval [list $lset a end-3 w
]
458 } {1 {list index out of range
}}
460 test lset-6.1
{lset, not compiled
, 3 args
, 1-d
list basics
} {
462 list [eval [list $lset a
0 a
]] $a
465 test lset-6.2
{lset, not compiled
, 3 args
, 1-d
list basics
} {
467 list [eval [list $lset a
[list 0] a
]] $a
470 test lset-6.3
{lset, not compiled
, 1-d
list basics
} {
472 list [eval [list $lset a
2 a
]] $a
475 test lset-6.4
{lset, not compiled
, 1-d
list basics
} {
477 list [eval [list $lset a
[list 2] a
]] $a
480 test lset-6.5
{lset, not compiled
, 1-d
list basics
} {
482 list [eval [list $lset a end a
]] $a
485 test lset-6.6
{lset, not compiled
, 1-d
list basics
} {
487 list [eval [list $lset a
[list end
] a
]] $a
490 test lset-6.7
{lset, not compiled
, 1-d
list basics
} {
492 list [eval [list $lset a end-0 a
]] $a
495 test lset-6.8
{lset, not compiled
, 1-d
list basics
} {
497 list [eval [list $lset a
[list end-0
] a
]] $a
499 test lset-6.9
{lset, not compiled
, 1-d
list basics
} {
501 list [eval [list $lset a end-2 a
]] $a
504 test lset-6.10
{lset, not compiled
, 1-d
list basics
} {
506 list [eval [list $lset a
[list end-2
] a
]] $a
509 test lset-7.1
{lset, not compiled
, data sharing
} {
511 list [eval [list $lset a
$a {gag me
}]] $a
512 } {{{gag me
}} {{gag me
}}}
514 test lset-7.2
{lset, not compiled
, data sharing
} {
516 list [eval [list $lset a
$a {gag me
}]] $a
517 } {{{gag me
}} {{gag me
}}}
519 test lset-7.3
{lset, not compiled
, data sharing
} {
521 list [eval [list $lset a
0 $a]] $a
522 } {{{x y
} y
} {{x y
} y
}}
524 test lset-7.4
{lset, not compiled
, data sharing
} {
526 list [eval [list $lset a
[list 0] $a]] $a
527 } {{{x y
} y
} {{x y
} y
}}
529 test lset-7.5
{lset, not compiled
, data sharing
} {
532 list [eval [list $lset a
$n $n]] $a $n
535 test lset-7.6
{lset, not compiled
, data sharing
} {
538 list [eval [list $lset a
$n $n]] $a $n
541 test lset-7.7
{lset, not compiled
, data sharing
} {
544 list [eval [list $lset a
$n 1]] $a $n
547 test lset-7.8
{lset, not compiled
, data sharing
} {
550 list [eval [list $lset a
$n 1]] $a $n
553 test lset-7.9
{lset, not compiled
, data sharing
} {
555 list [eval [list $lset a
$a $a]] $a
558 test lset-7.10
{lset, not compiled
, data sharing
} {
560 list [eval [list $lset a
$a $a]] $a
563 test lset-8.3
{lset, not compiled
, bad second index
} {
565 list [catch {eval [list $lset a
0 2a2 f
]} msg
] $msg
566 } {1 {bad index
"2a2": must be integer?
[+-]integer? or end?
[+-]integer?
}}
568 test lset-8.5
{lset, not compiled
, second index out of range
} {
569 set a
{{b c
} {d e
} {f g
}}
570 list [catch {eval [list $lset a
2 -1 h
]} msg
] $msg
571 } {1 {list index out of range
}}
573 test lset-8.7
{lset, not compiled
, second index out of range
} {
574 set a
{{b c
} {d e
} {f g
}}
575 list [catch {eval [list $lset a
2 2 h
]} msg
] $msg
576 } {1 {list index out of range
}}
578 test lset-8.9
{lset, not compiled
, second index out of range
} {
579 set a
{{b c
} {d e
} {f g
}}
580 list [catch {eval [list $lset a
2 end--1 h
]} msg
] $msg
581 } {1 {list index out of range
}}
583 test lset-8.11
{lset, not compiled
, second index out of range
} {
584 set a
{{b c
} {d e
} {f g
}}
585 list [catch {eval [list $lset a
2 end-2 h
]} msg
] $msg
586 } {1 {list index out of range
}}
588 test lset-9.1
{lset, not compiled
, entire
variable} {
590 list [eval [list $lset a y
]] $a
593 test lset-10.1
{lset, not compiled
, shared data
} {
595 set a
[list $row $row]
596 list [eval [list $lset a
0 0 x
]] $a
597 } {{{x q
} {p q
}} {{x q
} {p q
}}}
599 test lset-11.1
{lset, not compiled
, 2-d basics
} {
601 list [eval [list $lset a
0 0 f
]] $a
602 } {{{f c
} {d e
}} {{f c
} {d e
}}}
604 test lset-11.3
{lset, not compiled
, 2-d basics
} {
606 list [eval [list $lset a
0 1 f
]] $a
607 } {{{b f
} {d e
}} {{b f
} {d e
}}}
609 test lset-11.5
{lset, not compiled
, 2-d basics
} {
611 list [eval [list $lset a
1 0 f
]] $a
612 } {{{b c
} {f e
}} {{b c
} {f e
}}}
614 test lset-11.7
{lset, not compiled
, 2-d basics
} {
616 list [eval [list $lset a
1 1 f
]] $a
617 } {{{b c
} {d f
}} {{b c
} {d f
}}}
619 test lset-12.0
{lset, not compiled
, typical sharing pattern
} {
621 set row
[list $zero $zero $zero $zero]
622 set ident
[list $row $row $row $row]
623 for { set i
0 } { $i < 4 } { incr i
} {
624 eval [list $lset ident
$i $i 1]
627 } {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}}
629 test lset-13.0
{lset, not compiled
, shimmering hell
} {
631 list [eval [list $lset a
$a $a $a $a {gag me
}]] $a
632 } {{{{{{gag me
}}}}} {{{{{gag me
}}}}}}
634 test lset-13.1
{lset, not compiled
, shimmering hell
} {
636 list [eval [list $lset a
$a $a $a $a {gag me
}]] $a
637 } {{{{{{gag me
}}}}} {{{{{gag me
}}}}}}
639 test lset-14.1
{lset, not compiled
, list args
, is
string rep preserved?
} {
640 set a
{ { 1 2 } { 3 4 } }
641 catch { eval [list $lset a
{1 5} 5] }
642 list $a [lindex $a 1]
643 } "{ { 1 2 } { 3 4 } } { 3 4 }"
646 catch {unset noWrite
}
647 catch {rename failTrace
{}}
651 ################################################################################
653 ################################################################################
655 test if-1.1
{bad syntax
: lacking all
} {
658 test if-1.2
{bad syntax
: lacking then-clause
} {
661 test if-1.3
{bad syntax
: lacking then-clause
2} {
664 test if-1.4
{bad syntax
: lacking else-clause
after keyword '
else'
} {
665 catch {if 1==0 then
{list 1} else}
667 test if-1.5
{bad syntax
: lacking
expr after 'elseif'
} {
668 catch {if 1==0 then
{list 1} elseif
}
670 test if-1.6
{bad syntax
: lacking then-clause
after 'elseif'
} {
671 catch {if 1==0 then
{list 1} elseif
1==1}
673 test if-1.7
{bad syntax
: lacking else-clause
after 'elseif'
after keyword '
else'
} {
674 catch {if 1==0 then
{list 1} elseif
1==0 {list 2} else}
676 test if-1.8
{bad syntax
: extra arg
after implicit else-clause
} {
677 catch {if 1==0 {list 1} elseif
1==0 then
{list 2} {list 3} else}
679 test if-1.9
{bad syntax
: elsif-clause
after else-clause
} {
680 catch {if 1==0 {list 1} else {list 2} elseif
1==1 {list 3}}
682 test if-2.1
{taking proper branch
} {
684 if 0 {set a
1} else {set a
2}
687 test if-2.2
{taking proper branch
} {
689 if 1 {set a
1} else {set a
2}
692 test if-2.3
{taking proper branch
} {
697 test if-2.4
{taking proper branch
} {
702 test if-2.5
{taking proper branch
} {
704 if 0 {set a
1} else {}
707 test if-2.6
{taking proper branch
} {
709 if 0 {set a
1} elseif
1 {set a
2} elseif
1 {set a
3} else {set a
4}
712 test if-2.7
{taking proper branch
} {
714 if 0 {set a
1} elseif
0 {set a
2} elseif
1 {set a
3} else {set a
4}
717 test if-2.8
{taking proper branch
} {
719 if 0 {set a
1} elseif
0 {set a
2} elseif
0 {set a
3} else {set a
4}
722 test if-2.9
{taking proper branch
, multiline test
expr} {
725 3} {set a
3} else {set a
4}
728 test if-3.1
{optional then-else args
} {
730 if 0 then
{set a
1} elseif
0 then
{set a
3} else {set a
2}
733 test if-3.2
{optional then-else args
} {
735 if 1 then
{set a
1} else {set a
2}
738 test if-3.3
{optional then-else args
} {
740 if 0 {set a
1} else {set a
2}
743 test if-3.4
{optional then-else args
} {
745 if 1 {set a
1} else {set a
2}
748 test if-3.5
{optional then-else args
} {
750 if 0 then
{set a
1} {set a
2}
753 test if-3.6
{optional then-else args
} {
755 if 1 then
{set a
1} {set a
2}
758 test if-3.7
{optional then-else args
} {
760 if 0 then
{set a
1} else {set a
2}
763 test if-3.8
{optional then-else args
} {
765 if 0 then
{set a
1} elseif
0 {set a
2} elseif
0 {set a
3} {set a
4}
768 test if-4.1
{return value
} {
769 if 1 then
{set a
22; concat abc
}
771 test if-4.2
{return value
} {
772 if 0 then
{set a
22; concat abc
} elseif
1 {concat def
} {concat ghi
}
774 test if-4.3
{return value
} {
775 if 0 then
{set a
22; concat abc
} else {concat def
}
777 test if-4.4
{return value
} {
778 if 0 then
{set a
22; concat abc
}
780 test if-4.5
{return value
} {
781 if 0 then
{set a
22; concat abc
} elseif
0 {concat def
}
783 test if-5.1
{error conditions
} {
784 list [catch {if {[error "error in condition"]} foo
} msg
] $msg
785 } {1 {error in condition
}}
786 test if-5.2
{error conditions
} {
787 list [catch {if 2 the
} msg
] $msg
788 } {1 {invalid command name
"the"}}
789 test if-5.3
{error conditions
} {
790 list [catch {if 2 then
{[error "error in then clause"]}} msg
] $msg
791 } {1 {error in then clause
}}
792 test if-5.4
{error conditions
} {
793 list [catch {if 0 then foo elsei
} msg
] $msg
794 } {1 {invalid command name
"elsei"}}
795 test if-5.5
{error conditions
} {
796 list [catch {if 0 then foo elseif
0 bar els
} msg
] $msg
797 } {1 {invalid command name
"els"}}
798 test if-5.6
{error conditions
} {
799 list [catch {if 0 then foo elseif
0 bar
else {[error "error in else clause"]}} msg
] $msg
800 } {1 {error in
else clause
}}
802 ################################################################################
804 ################################################################################
808 test append-1.1
{append command
} {
810 list [append x
1 2 abc
"long string"] $x
811 } {{12abclong
string} {12abclong
string}}
812 test append-1.2
{append command
} {
814 list [append x first
] [append x second
] [append x third
] $x
815 } {first firstsecond firstsecondthird firstsecondthird
}
816 test append-1.3
{append command
} {
821 test append-2.1
{long appends
} {
823 for {set i
0} {$i < 1000} {set i
[expr $i+1]} {
827 set y
"$y $y $y $y $y $y $y $y $y $y"
828 set y
"$y $y $y $y $y $y $y $y $y $y"
829 set y
"$y $y $y $y $y $y $y $y $y $y "
833 test append-3.1
{append errors
} {
834 list [catch {append} msg
] $msg
835 } {1 {wrong
# args: should be "append varName ?value value ...?"}}
836 test append-3.2
{append errors
} {
838 list [catch {append x
(0) 44} msg
] $msg
839 } {1 {can't
set "x(0)": variable isn't
array}}
840 test append-3.3
{append errors
} {
842 list [catch {append x
} msg
] $msg
843 } {1 {can't
read "x": no such
variable}}
845 test append-4.1
{lappend command
} {
847 list [lappend x
1 2 abc
"long string"] $x
848 } {{1 2 abc
{long
string}} {1 2 abc
{long
string}}}
849 test append-4.2
{lappend command
} {
851 list [lappend x first
] [lappend x second
] [lappend x third
] $x
852 } {first
{first second
} {first second third
} {first second third
}}
853 test append-4.3
{lappend command
} {
864 test append-4.4
{lappend command
} {
868 test append-4.5
{lappend command
} {
872 test append-4.6
{lappend command
} {
876 test append-4.7
{lappend command
} {
880 test append-4.8
{lappend command
} {
884 #test append-4.9 {lappend command} {
886 # list [catch {lappend x abc} msg] $msg
887 #} {1 {unmatched open brace in list}}
888 #test append-4.10 {lappend command} {
890 # list [catch {lappend x abc} msg] $msg
891 #} {1 {unmatched open brace in list}}
892 #test append-4.11 {lappend command} {
894 # list [catch {lappend x abc} msg] $msg
895 #} {1 {unmatched open brace in list}}
896 #test append-4.12 {lappend command} {
898 # list [catch {lappend x abc} msg] $msg
899 #} {1 {unmatched open brace in list}}
900 test append-4.13
{lappend command
} {
903 } "x\\\{\\\{\\\{ abc"
904 test append-4.14
{lappend command
} {
908 test append-4.15
{lappend command
} {
912 test append-4.16
{lappend command
} {
916 test append-4.17
{lappend command
} {
920 test append-4.18
{lappend command
} {
924 test append-4.19
{lappend command
} {
928 test append-4.20
{lappend command
} {
933 proc check
{var size
} {
936 return "length mismatch: should have been $size, was $l"
938 for {set i
0} {$i < $size} {set i
[expr $i+1]} {
939 set j
[lindex $var $i]
940 if {$j ne
"item $i"} {
941 return "element $i should have been \"item $i\", was \"$j\""
946 test append-5.1
{long lappends
} {
949 for {set i
0} {$i < 300} {set i
[expr $i+1]} {
955 test append-6.1
{lappend errors
} {
956 list [catch {lappend} msg
] $msg
957 } {1 {wrong
# args: should be "lappend varName ?value value ...?"}}
958 test append-6.2
{lappend errors
} {
960 list [catch {lappend x
(0) 44} msg
] $msg
961 } {1 {can't
set "x(0)": variable isn't
array}}
963 ################################################################################
965 ################################################################################
968 newset z
[expr $x+$y]
971 proc newset
{name value
} {
972 uplevel set $name $value
973 uplevel 1 {uplevel 1 {set xyz
22}}
976 test uplevel-1.1
{simple operation
} {
980 test uplevel-1.2
{command is another
uplevel command
} {
1000 uplevel #2 set y 222
1002 uplevel #1 set y 444
1004 uplevel #0 set y 666
1007 test uplevel-2.1
{relative and absolute
uplevel} {set a
} 333
1008 test uplevel-2.2
{relative and absolute
uplevel} {set a1
} 444
1009 test uplevel-2.3
{relative and absolute
uplevel} {set b
} 111
1010 test uplevel-2.4
{relative and absolute
uplevel} {set b1
} 222
1011 test uplevel-2.5
{relative and absolute
uplevel} {set x
} 555
1012 test uplevel-2.6
{relative and absolute
uplevel} {set y
} 666
1014 test uplevel-3.1
{uplevel to same level
} {
1019 test uplevel-3.2
{uplevel to same level
} {
1023 test uplevel-3.3
{uplevel to same level
} {
1025 proc a1
{} {set y
55; uplevel 0 set y
66; return $y}
1028 test uplevel-3.4
{uplevel to same level
} {
1030 proc a1
{} {set y
55; uplevel #1 set y}
1034 test uplevel-4.1
{error: non-existent level
} {
1035 list [catch c1 msg
] $msg
1036 } {1 {bad level
"#2"}}
1037 test uplevel-4.2
{error: non-existent level
} {
1038 proc c2
{} {uplevel 3 {set a b
}}
1039 list [catch c2 msg
] $msg
1040 } {1 {bad level
"3"}}
1041 test uplevel-4.3
{error: not enough args
} {
1042 list [catch uplevel msg
] $msg
1043 } {1 {wrong
# args: should be "uplevel ?level? command ?arg ...?"}}
1044 test uplevel-4.4
{error: not enough args
} {
1045 proc upBug
{} {uplevel 1}
1046 list [catch upBug msg
] $msg
1047 } {1 {wrong
# args: should be "uplevel ?level? command ?arg ...?"}}
1055 set y
[info level
1]
1058 test uplevel-5.1
{info level
} {set x
} 1
1059 test uplevel-5.2
{info level
} {set y
} a3
1061 ################################################################################
1063 ################################################################################
1066 catch {rename unknown unknown.old
}
1068 test unknown-1.1
{non-existent
"unknown" command
} {
1069 list [catch {_non-existent_ foo bar
} msg
] $msg
1070 } {1 {invalid command name
"_non-existent_"}}
1072 proc unknown {args
} {
1077 test unknown-2.1
{calling
"unknown" command
} {
1081 test unknown-2.2
{calling
"unknown" command with lots of args
} {
1082 foobar
1 2 3 4 5 6 7
1084 } {foobar
1 2 3 4 5 6 7}
1085 test unknown-2.3
{calling
"unknown" command with lots of args
} {
1086 foobar
1 2 3 4 5 6 7 8
1088 } {foobar
1 2 3 4 5 6 7 8}
1089 test unknown-2.4
{calling
"unknown" command with lots of args
} {
1090 foobar
1 2 3 4 5 6 7 8 9
1092 } {foobar
1 2 3 4 5 6 7 8 9}
1094 test unknown-3.1
{argument quoting in calls to
"unknown"} {
1095 foobar
\{ \} a
\{b
\; "\\" \$a a
\[b
\]
1097 } "foobar \\{ \\} a\\{b {;} \\\\ {\$a} {a\[b} \\]"
1100 error "unknown failed"
1103 test unknown-4.1
{errors in
"unknown" procedure
} {
1104 list [catch {non-existent a b
} msg
] $msg
1105 } {1 {unknown failed
}}
1109 ################################################################################
1111 ################################################################################
1116 test incr-1.1
{TclCompileIncrCmd
: missing
variable name
} {
1117 list [catch {incr} msg
] $msg
1118 } {1 {wrong
# args: should be "incr varName ?increment?"}}
1119 test incr-1.2
{TclCompileIncrCmd
: simple
variable name
} {
1123 #test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
1125 # catch {incr "i"xxx} msg
1127 #} {extra characters after close-quote}
1128 test incr-1.4
{TclCompileIncrCmd
: simple
variable name in quotes
} {
1132 test incr-1.5
{TclCompileIncrCmd
: simple
variable name in braces
} {
1133 catch {unset {a simple var
}}
1134 set {a simple var
} 27
1135 list [incr {a simple var
}] ${a simple var
}
1137 test incr-1.6
{TclCompileIncrCmd
: simple
array variable name
} {
1140 list [incr a
(foo
)] $a(foo
)
1142 test incr-1.7
{TclCompileIncrCmd
: non-simple
(computed
) variable name
} {
1147 test incr-1.8
{TclCompileIncrCmd
: non-simple
(computed
) variable name
} {
1150 list [incr [set x
] +2] $i
1153 test incr-1.9
{TclCompileIncrCmd
: increment given
} {
1155 list [incr i
+07] $i
1157 test incr-1.10
{TclCompileIncrCmd
: no increment given
} {
1162 test incr-1.11
{TclCompileIncrCmd
: simple
global name
} {
1170 test incr-1.12
{TclCompileIncrCmd
: simple local name
} {
1177 test incr-1.13
{TclCompileIncrCmd
: simple but new
(unknown) local name
} {
1184 test incr-1.14
{TclCompileIncrCmd
: simple local name
, >255 locals
} {
1187 set a0
0; set a1
0; set a2
0; set a3
0; set a4
0
1188 set a5
0; set a6
0; set a7
0; set a8
0; set a9
0
1189 set b0
0; set b1
0; set b2
0; set b3
0; set b4
0
1190 set b5
0; set b6
0; set b7
0; set b8
0; set b9
0
1191 set c0
0; set c1
0; set c2
0; set c3
0; set c4
0
1192 set c5
0; set c6
0; set c7
0; set c8
0; set c9
0
1193 set d0
0; set d1
0; set d2
0; set d3
0; set d4
0
1194 set d5
0; set d6
0; set d7
0; set d8
0; set d9
0
1195 set e0
0; set e1
0; set e2
0; set e3
0; set e4
0
1196 set e5
0; set e6
0; set e7
0; set e8
0; set e9
0
1197 set f0
0; set f1
0; set f2
0; set f3
0; set f4
0
1198 set f5
0; set f6
0; set f7
0; set f8
0; set f9
0
1199 set g0
0; set g1
0; set g2
0; set g3
0; set g4
0
1200 set g5
0; set g6
0; set g7
0; set g8
0; set g9
0
1201 set h0
0; set h1
0; set h2
0; set h3
0; set h4
0
1202 set h5
0; set h6
0; set h7
0; set h8
0; set h9
0
1203 set i0
0; set i1
0; set i2
0; set i3
0; set i4
0
1204 set i5
0; set i6
0; set i7
0; set i8
0; set i9
0
1205 set j0
0; set j1
0; set j2
0; set j3
0; set j4
0
1206 set j5
0; set j6
0; set j7
0; set j8
0; set j9
0
1207 set k0
0; set k1
0; set k2
0; set k3
0; set k4
0
1208 set k5
0; set k6
0; set k7
0; set k8
0; set k9
0
1209 set l0
0; set l1
0; set l2
0; set l3
0; set l4
0
1210 set l5
0; set l6
0; set l7
0; set l8
0; set l9
0
1211 set m0
0; set m1
0; set m2
0; set m3
0; set m4
0
1212 set m5
0; set m6
0; set m7
0; set m8
0; set m9
0
1213 set n0
0; set n1
0; set n2
0; set n3
0; set n4
0
1214 set n5
0; set n6
0; set n7
0; set n8
0; set n9
0
1215 set o0
0; set o1
0; set o2
0; set o3
0; set o4
0
1216 set o5
0; set o6
0; set o7
0; set o8
0; set o9
0
1217 set p0
0; set p1
0; set p2
0; set p3
0; set p4
0
1218 set p5
0; set p6
0; set p7
0; set p8
0; set p9
0
1219 set q0
0; set q1
0; set q2
0; set q3
0; set q4
0
1220 set q5
0; set q6
0; set q7
0; set q8
0; set q9
0
1221 set r0
0; set r1
0; set r2
0; set r3
0; set r4
0
1222 set r5
0; set r6
0; set r7
0; set r8
0; set r9
0
1223 set s0
0; set s1
0; set s2
0; set s3
0; set s4
0
1224 set s5
0; set s6
0; set s7
0; set s8
0; set s9
0
1225 set t0
0; set t1
0; set t2
0; set t3
0; set t4
0
1226 set t5
0; set t6
0; set t7
0; set t8
0; set t9
0
1227 set u0
0; set u1
0; set u2
0; set u3
0; set u4
0
1228 set u5
0; set u6
0; set u7
0; set u8
0; set u9
0
1229 set v0
0; set v1
0; set v2
0; set v3
0; set v4
0
1230 set v5
0; set v6
0; set v7
0; set v8
0; set v9
0
1231 set w0
0; set w1
0; set w2
0; set w3
0; set w4
0
1232 set w5
0; set w6
0; set w7
0; set w8
0; set w9
0
1233 set x0
0; set x1
0; set x2
0; set x3
0; set x4
0
1234 set x5
0; set x6
0; set x7
0; set x8
0; set x9
0
1235 set y0
0; set y1
0; set y2
0; set y3
0; set y4
0
1236 set y5
0; set y6
0; set y7
0; set y8
0; set y9
0
1237 set z0
0; set z1
0; set z2
0; set z3
0; set z4
0
1238 set z5
0; set z6
0; set z7
0; set z8
0; set z9
0
1239 # now increment the last one (local var index > 255)
1244 test incr-1.15
{TclCompileIncrCmd
: variable is
array} {
1247 set x
[incr a
(foo
) 11]
1251 test incr-1.16
{TclCompileIncrCmd
: variable is
array, elem substitutions
} {
1255 set x
[incr a
(foo
$i) 11]
1260 test incr-1.17
{TclCompileIncrCmd
: increment given
, simple int
} {
1264 test incr-1.18
{TclCompileIncrCmd
: increment given
, simple int
} {
1268 #test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} {
1270 # catch {incr i [set]} msg
1272 #} {wrong # args: should be "set varName ?newValue?"
1277 test incr-1.20
{TclCompileIncrCmd
: increment given
, in quotes
} {
1281 test incr-1.21
{TclCompileIncrCmd
: increment given
, in braces
} {
1285 test incr-1.22
{TclCompileIncrCmd
: increment given
, large int
} {
1289 test incr-1.23
{TclCompileIncrCmd
: increment given
, formatted int
!= int
} {
1291 incr i
000012345 ;# an octal literal
1293 test incr-1.24
{TclCompileIncrCmd
: increment given
, formatted int
!= int
} {
1295 catch {incr i
1a
} msg
1297 } {expected integer but got
"1a"}
1299 test incr-1.25
{TclCompileIncrCmd
: too many arguments
} {
1301 catch {incr i
10 20} msg
1303 } {wrong
# args: should be "incr varName ?increment?"}
1306 test incr-1.29
{TclCompileIncrCmd
: runtime
error, bad
variable value
} {
1308 list [catch {incr x
1} msg
] $msg
1309 } {1 {expected integer but got
" - "}}
1311 test incr-1.30
{TclCompileIncrCmd
: array var
, braced
(no subs
)} {
1317 # Check "incr" and computed command names.
1319 test incr-2.0
{incr and computed command names
} {
1328 test incr-2.1
{incr command
(not compiled
): missing
variable name
} {
1330 list [catch {$z} msg
] $msg
1331 } {1 {wrong
# args: should be "incr varName ?increment?"}}
1332 test incr-2.2
{incr command
(not compiled
): simple
variable name
} {
1337 test incr-2.4
{incr command
(not compiled
): simple
variable name in quotes
} {
1342 test incr-2.5
{incr command
(not compiled
): simple
variable name in braces
} {
1344 catch {unset {a simple var
}}
1345 set {a simple var
} 27
1346 list [$z {a simple var
}] ${a simple var
}
1348 test incr-2.6
{incr command
(not compiled
): simple
array variable name
} {
1352 list [$z a
(foo
)] $a(foo
)
1354 test incr-2.7
{incr command
(not compiled
): non-simple
(computed
) variable name
} {
1360 test incr-2.8
{incr command
(not compiled
): non-simple
(computed
) variable name
} {
1364 list [$z [set x
] +2] $i
1367 test incr-2.9
{incr command
(not compiled
): increment given
} {
1372 test incr-2.10
{incr command
(not compiled
): no increment given
} {
1378 test incr-2.11
{incr command
(not compiled
): simple
global name
} {
1387 test incr-2.12
{incr command
(not compiled
): simple local name
} {
1395 test incr-2.13
{incr command
(not compiled
): simple but new
(unknown) local name
} {
1403 test incr-2.14
{incr command
(not compiled
): simple local name
, >255 locals
} {
1407 set a0
0; set a1
0; set a2
0; set a3
0; set a4
0
1408 set a5
0; set a6
0; set a7
0; set a8
0; set a9
0
1409 set b0
0; set b1
0; set b2
0; set b3
0; set b4
0
1410 set b5
0; set b6
0; set b7
0; set b8
0; set b9
0
1411 set c0
0; set c1
0; set c2
0; set c3
0; set c4
0
1412 set c5
0; set c6
0; set c7
0; set c8
0; set c9
0
1413 set d0
0; set d1
0; set d2
0; set d3
0; set d4
0
1414 set d5
0; set d6
0; set d7
0; set d8
0; set d9
0
1415 set e0
0; set e1
0; set e2
0; set e3
0; set e4
0
1416 set e5
0; set e6
0; set e7
0; set e8
0; set e9
0
1417 set f0
0; set f1
0; set f2
0; set f3
0; set f4
0
1418 set f5
0; set f6
0; set f7
0; set f8
0; set f9
0
1419 set g0
0; set g1
0; set g2
0; set g3
0; set g4
0
1420 set g5
0; set g6
0; set g7
0; set g8
0; set g9
0
1421 set h0
0; set h1
0; set h2
0; set h3
0; set h4
0
1422 set h5
0; set h6
0; set h7
0; set h8
0; set h9
0
1423 set i0
0; set i1
0; set i2
0; set i3
0; set i4
0
1424 set i5
0; set i6
0; set i7
0; set i8
0; set i9
0
1425 set j0
0; set j1
0; set j2
0; set j3
0; set j4
0
1426 set j5
0; set j6
0; set j7
0; set j8
0; set j9
0
1427 set k0
0; set k1
0; set k2
0; set k3
0; set k4
0
1428 set k5
0; set k6
0; set k7
0; set k8
0; set k9
0
1429 set l0
0; set l1
0; set l2
0; set l3
0; set l4
0
1430 set l5
0; set l6
0; set l7
0; set l8
0; set l9
0
1431 set m0
0; set m1
0; set m2
0; set m3
0; set m4
0
1432 set m5
0; set m6
0; set m7
0; set m8
0; set m9
0
1433 set n0
0; set n1
0; set n2
0; set n3
0; set n4
0
1434 set n5
0; set n6
0; set n7
0; set n8
0; set n9
0
1435 set o0
0; set o1
0; set o2
0; set o3
0; set o4
0
1436 set o5
0; set o6
0; set o7
0; set o8
0; set o9
0
1437 set p0
0; set p1
0; set p2
0; set p3
0; set p4
0
1438 set p5
0; set p6
0; set p7
0; set p8
0; set p9
0
1439 set q0
0; set q1
0; set q2
0; set q3
0; set q4
0
1440 set q5
0; set q6
0; set q7
0; set q8
0; set q9
0
1441 set r0
0; set r1
0; set r2
0; set r3
0; set r4
0
1442 set r5
0; set r6
0; set r7
0; set r8
0; set r9
0
1443 set s0
0; set s1
0; set s2
0; set s3
0; set s4
0
1444 set s5
0; set s6
0; set s7
0; set s8
0; set s9
0
1445 set t0
0; set t1
0; set t2
0; set t3
0; set t4
0
1446 set t5
0; set t6
0; set t7
0; set t8
0; set t9
0
1447 set u0
0; set u1
0; set u2
0; set u3
0; set u4
0
1448 set u5
0; set u6
0; set u7
0; set u8
0; set u9
0
1449 set v0
0; set v1
0; set v2
0; set v3
0; set v4
0
1450 set v5
0; set v6
0; set v7
0; set v8
0; set v9
0
1451 set w0
0; set w1
0; set w2
0; set w3
0; set w4
0
1452 set w5
0; set w6
0; set w7
0; set w8
0; set w9
0
1453 set x0
0; set x1
0; set x2
0; set x3
0; set x4
0
1454 set x5
0; set x6
0; set x7
0; set x8
0; set x9
0
1455 set y0
0; set y1
0; set y2
0; set y3
0; set y4
0
1456 set y5
0; set y6
0; set y7
0; set y8
0; set y9
0
1457 set z0
0; set z1
0; set z2
0; set z3
0; set z4
0
1458 set z5
0; set z6
0; set z7
0; set z8
0; set z9
0
1459 # now increment the last one (local var index > 255)
1464 test incr-2.15
{incr command
(not compiled
): variable is
array} {
1468 set x
[$z a
(foo
) 11]
1472 test incr-2.16
{incr command
(not compiled
): variable is
array, elem substitutions
} {
1477 set x
[$z a
(foo
$i) 11]
1482 test incr-2.17
{incr command
(not compiled
): increment given
, simple int
} {
1487 test incr-2.18
{incr command
(not compiled
): increment given
, simple int
} {
1492 test incr-2.20
{incr command
(not compiled
): increment given
, in quotes
} {
1497 test incr-2.21
{incr command
(not compiled
): increment given
, in braces
} {
1502 test incr-2.22
{incr command
(not compiled
): increment given
, large int
} {
1507 test incr-2.23
{incr command
(not compiled
): increment given
, formatted int
!= int
} {
1510 $z i
000012345 ;# an octal literal
1512 test incr-2.24
{incr command
(not compiled
): increment given
, formatted int
!= int
} {
1517 } {expected integer but got
"1a"}
1519 test incr-2.25
{incr command
(not compiled
): too many arguments
} {
1522 catch {$z i
10 20} msg
1524 } {wrong
# args: should be "incr varName ?increment?"}
1526 test incr-2.29
{incr command
(not compiled
): runtime
error, bad
variable value
} {
1529 list [catch {$z x
1} msg
] $msg
1530 } {1 {expected integer but got
" - "}}
1532 ################################################################################
1534 ################################################################################
1536 test llength-1.1
{length of
list} {
1539 test llength-1.2
{length of
list} {
1540 llength {a b c
{a b
{c d
}} d
}
1542 test llength-1.3
{length of
list} {
1546 test llength-2.1
{error conditions
} {
1547 list [catch {llength} msg
] $msg
1548 } {1 {wrong
# args: should be "llength list"}}
1549 test llength-2.2
{error conditions
} {
1550 list [catch {llength 123 2} msg
] $msg
1551 } {1 {wrong
# args: should be "llength list"}}
1553 ################################################################################
1555 ################################################################################
1560 # Tests of Tcl_LindexObjCmd, NOT COMPILED
1562 #test lindex-1.1 {wrong # args} {
1563 # list [catch {eval $lindex} result] $result
1564 #} "1 {wrong # args: should be \"lindex list ?index...?\"}"
1566 # Indices that are lists or convertible to lists
1568 #test lindex-2.1 {empty index list} {
1570 # list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1571 #} {{a b c} {a b c}}
1573 test lindex-2.2
{singleton index
list} {
1575 list [eval [list $lindex {a b c
} $x]] [eval [list $lindex {a b c
} $x]]
1578 test lindex-2.4
{malformed index
list} {
1580 list [catch { eval [list $lindex {a b c
} $x] } result
] $result
1581 } {1 bad
\ index
\ \"\{\":\ must
\ be
\ integer?
\[+-\]integer?
\ or
\ end?
\[+-\]integer?
}
1583 # Indices that are integers or convertible to integers
1585 test lindex-3.1
{integer
-1} {
1587 list [eval [list $lindex {a b c
} $x]] [eval [list $lindex {a b c
} $x]]
1590 test lindex-3.2
{integer
0} {
1591 set x
[string range
00 0 0]
1592 list [eval [list $lindex {a b c
} $x]] [eval [list $lindex {a b c
} $x]]
1595 test lindex-3.3
{integer
2} {
1596 set x
[string range
22 0 0]
1597 list [eval [list $lindex {a b c
} $x]] [eval [list $lindex {a b c
} $x]]
1600 test lindex-3.4
{integer
3} {
1601 set x
[string range
33 0 0]
1602 list [eval [list $lindex {a b c
} $x]] [eval [list $lindex {a b c
} $x]]
1605 test lindex-3.7
{indexes don't shimmer wide ints
} {
1606 set x
[expr {(1<<31) - 2}]
1607 list $x [lindex {1 2 3} $x] [incr x
] [incr x
]
1608 } {2147483646 {} 2147483647 2147483648}
1610 # Indices relative to end
1612 test lindex-4.1
{index
= end
} {
1614 list [eval [list $lindex {a b c
} $x]] [eval [list $lindex {a b c
} $x]]
1617 test lindex-4.2
{index
= end--1
} {
1619 list [eval [list $lindex {a b c
} $x]] [eval [list $lindex {a b c
} $x]]
1622 test lindex-4.3
{index
= end-0
} {
1624 list [eval [list $lindex {a b c
} $x]] [eval [list $lindex {a b c
} $x]]
1627 test lindex-4.4
{index
= end-2
} {
1629 list [eval [list $lindex {a b c
} $x]] [eval [list $lindex {a b c
} $x]]
1632 test lindex-4.5
{index
= end-3
} {
1634 list [eval [list $lindex {a b c
} $x]] [eval [list $lindex {a b c
} $x]]
1637 test lindex-4.8
{bad integer
, not octal
} {
1639 list [catch { eval [list $lindex {a b c
} $x] } result
] $result
1640 } {1 {bad index
"end-0a2": must be integer?
[+-]integer? or end?
[+-]integer?
}}
1642 #test lindex-4.9 {incomplete end} {
1644 # list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1647 test lindex-4.10
{incomplete end-
} {
1649 list [catch { eval [list $lindex {a b c
} $x] } result
] $result
1650 } {1 {bad index
"end-": must be integer?
[+-]integer? or end?
[+-]integer?
}}
1652 test lindex-5.1
{bad second index
} {
1653 list [catch { eval [list $lindex {a b c
} 0 0a2
] } result
] $result
1654 } {1 {bad index
"0a2": must be integer?
[+-]integer? or end?
[+-]integer?
}}
1656 test lindex-5.2
{good second index
} {
1657 eval [list $lindex {{a b c
} {d e f
} {g h i
}} 1 2]
1660 test lindex-5.3
{three indices
} {
1661 eval [list $lindex {{{a b
} {c d
}} {{e f
} {g h
}}} 1 0 1]
1664 test lindex-7.1
{quoted elements
} {
1665 eval [list $lindex {a
"b c" d
} 1]
1667 test lindex-7.2
{quoted elements
} {
1668 eval [list $lindex {"{}" b c
} 0]
1670 test lindex-7.3
{quoted elements
} {
1671 eval [list $lindex {ab
"c d \" x" y
} 1]
1673 test lindex-7.4 {quoted elements} {
1674 lindex {a b {c d "e
} {f g
"}} 2
1677 test lindex-8.1
{data reuse
} {
1679 eval [list $lindex $x $x]
1682 test lindex-8.2
{data reuse
} {
1684 eval [list $lindex $a $a $a]
1686 test lindex-8.3
{data reuse
} {
1688 eval [list $lindex $a $a $a]
1691 #----------------------------------------------------------------------
1693 test lindex-10.2
{singleton index
list} {
1696 list [lindex {a b c
} $x] [lindex {a b c
} $x]
1701 test lindex-10.4
{malformed index
list} {
1703 list [catch { lindex {a b c
} $x } result
] $result
1704 } {1 bad
\ index
\ \"\{\":\ must
\ be
\ integer?
\[+-\]integer?
\ or
\ end?
\[+-\]integer?
}
1706 # Indices that are integers or convertible to integers
1708 test lindex-11.1
{integer
-1} {
1711 list [lindex {a b c
} $x] [lindex {a b c
} $x]
1716 test lindex-11.2
{integer
0} {
1717 set x
[string range
00 0 0]
1719 list [lindex {a b c
} $x] [lindex {a b c
} $x]
1724 test lindex-11.3
{integer
2} {
1725 set x
[string range
22 0 0]
1727 list [lindex {a b c
} $x] [lindex {a b c
} $x]
1732 test lindex-11.4
{integer
3} {
1733 set x
[string range
33 0 0]
1735 list [lindex {a b c
} $x] [lindex {a b c
} $x]
1740 # Indices relative to end
1741 test lindex-12.1
{index
= end
} {
1744 list [lindex {a b c
} $x] [lindex {a b c
} $x]
1749 test lindex-12.2
{index
= end--1
} {
1752 list [lindex {a b c
} $x] [lindex {a b c
} $x]
1757 test lindex-12.3
{index
= end-0
} {
1760 list [lindex {a b c
} $x] [lindex {a b c
} $x]
1765 test lindex-12.4
{index
= end-2
} {
1768 list [lindex {a b c
} $x] [lindex {a b c
} $x]
1773 test lindex-12.5
{index
= end-3
} {
1776 list [lindex {a b c
} $x] [lindex {a b c
} $x]
1781 test lindex-12.8
{bad integer
, not octal
} {
1783 list [catch { lindex {a b c
} $x } result
] $result
1784 } {1 {bad index
"end-0a2": must be integer?
[+-]integer? or end?
[+-]integer?
}}
1786 test lindex-12.10
{incomplete end-
} {
1788 list [catch { lindex {a b c
} $x } result
] $result
1789 } {1 {bad index
"end-": must be integer?
[+-]integer? or end?
[+-]integer?
}}
1791 test lindex-13.1
{bad second index
} {
1792 list [catch { lindex {a b c
} 0 0a2
} result
] $result
1793 } {1 {bad index
"0a2": must be integer?
[+-]integer? or end?
[+-]integer?
}}
1795 test lindex-13.2
{good second index
} {
1797 lindex {{a b c
} {d e f
} {g h i
}} 1 2
1802 test lindex-13.3
{three indices
} {
1804 lindex {{{a b
} {c d
}} {{e f
} {g h
}}} 1 0 1
1809 test lindex-15.1
{quoted elements
} {
1811 lindex {a
"b c" d
} 1
1815 test lindex-15.2
{quoted elements
} {
1821 test lindex-15.3
{quoted elements
} {
1823 lindex {ab
"c d \" x" y
} 1
1827 test lindex-15.4 {quoted elements} {
1829 lindex {a b {c d "e
} {f g
"}} 2
1834 test lindex-16.1
{data reuse
} {
1842 test lindex-16.2
{data reuse
} {
1849 test lindex-16.3
{data reuse
} {
1857 catch { unset lindex}
1858 catch { unset minus
}
1860 ################################################################################
1862 ################################################################################
1867 # Basic "foreach" operation.
1869 test foreach-1.1
{basic
foreach tests
} {
1871 foreach i
{a b c d
} {
1872 set a
[concat $a $i]
1876 test foreach-1.2
{basic
foreach tests
} {
1878 foreach i
{a b
{{c d
} e
} {123 {{x
}}}} {
1879 set a
[concat $a $i]
1882 } {a b
{c d
} e
123 {{x
}}}
1883 test foreach-1.3
{basic
foreach tests
} {catch {foreach} msg
} 1
1884 test foreach-1.4
{basic
foreach tests
} {catch {foreach i
} msg
} 1
1885 test foreach-1.5
{basic
foreach tests
} {catch {foreach i j
} msg
} 1
1886 test foreach-1.6
{basic
foreach tests
} {catch {foreach i j k l
} msg
} 1
1887 test foreach-1.7
{basic
foreach tests
} {
1890 set a
[concat $a $i]
1895 test foreach-2.1
{foreach errors
} {
1896 list [catch {foreach {} {} {}} msg
] $msg
1897 } {1 {foreach varlist is empty
}}
1900 test foreach-3.1
{parallel
foreach tests
} {
1902 foreach {a b
} {1 2 3 4} {
1907 test foreach-3.2
{parallel
foreach tests
} {
1909 foreach {a b
} {1 2 3 4 5} {
1914 test foreach-3.3
{parallel
foreach tests
} {
1916 foreach a
{1 2 3} b
{4 5 6} {
1921 test foreach-3.4
{parallel
foreach tests
} {
1923 foreach a
{1 2 3} b
{4 5 6 7 8} {
1928 test foreach-3.5
{parallel
foreach tests
} {
1930 foreach {a b
} {a b A B aa bb
} c
{c C cc CC
} {
1935 test foreach-3.6
{parallel
foreach tests
} {
1937 foreach a
{1 2 3} b
{1 2 3} c
{1 2 3} d
{1 2 3} e
{1 2 3} {
1938 append x
$a $b $c $d $e
1942 test foreach-3.7
{parallel
foreach tests
} {
1944 foreach a
{} b
{1 2 3} c
{1 2} d
{1 2 3 4} e
{{1 2}} {
1945 append x
$a $b $c $d $e
1949 test foreach-4.1
{foreach only sets vars
if repeating loop
} {
1952 foreach {r g b
} [set rgb
] {}
1953 return "r=$r, g=$g, b=$b"
1956 } {r
=65535, g
=0, b
=0}
1957 test foreach-5.1
{foreach supports dict syntactic sugar
} {
1960 foreach {a
(3)} {1 2 3 4} {lappend x
[set {a
(3)}]}
1966 test foreach-6.1
{noncompiled
foreach and shared
variable or value
list objects that are converted to another type
} {
1968 foreach {12.0} {a b c
} {
1977 test foreach-7.1
{continue tests
} {catch continue} 4
1978 test foreach-7.2
{continue tests
} {
1980 foreach i
{a b c d
} {
1981 if {[string compare
$i "b"] == 0} continue
1982 set a
[concat $a $i]
1986 test foreach-7.3
{continue tests
} {
1988 foreach i
{a b c d
} {
1989 if {[string compare
$i "b"] != 0} continue
1990 set a
[concat $a $i]
1994 test foreach-7.4
{continue tests
} {catch {continue foo
} msg
} 1
1995 test foreach-7.5
{continue tests
} {
1996 catch {continue foo
} msg
1998 } {wrong
# args: should be "continue"}
2002 test foreach-8.1
{break tests
} {catch break} 3
2003 test foreach-8.2
{break tests
} {
2005 foreach i
{a b c d
} {
2006 if {[string compare
$i "c"] == 0} break
2007 set a
[concat $a $i]
2011 test foreach-8.3
{break tests
} {catch {break foo
} msg
} 1
2012 test foreach-8.4
{break tests
} {
2013 catch {break foo
} msg
2015 } {wrong
# args: should be "break"}
2017 # Test for incorrect "double evaluation" semantics
2019 test foreach-9.1
{delayed substitution of body
- knownbugs
} {
2022 foreach a
[list 1 2 3] "
2034 ################################################################################
2036 ################################################################################
2039 test string-7.1
{string last
, too few args
} {
2040 list [catch {string last a
} msg
] $msg
2041 } {1 {wrong
# args: should be "string last subString string ?index?"}}
2042 test string-7.2
{string last
, bad args
} {
2043 list [catch {string last a b c
} msg
] $msg
2044 } {1 {bad index
"c": must be integer?
[+-]integer? or end?
[+-]integer?
}}
2045 test string-7.3
{string last
, too many args
} {
2046 list [catch {string last a b c d
} msg
] $msg
2047 } {1 {wrong
# args: should be "string last subString string ?index?"}}
2048 test string-7.5
{string last
} {
2049 string last xx xxxx123xx345x678
2051 test string-7.13
{string last
, start index
} {
2052 ## Constrain to last 'a' should work
2053 string last ba badbad end-1
2055 test string-7.14
{string last
, start index
} {
2056 ## Constrain to last 'b' should skip last 'ba'
2057 string last ba badbad end-2
2062 test string-11.1
{string match
, too few args
} {
2063 proc foo
{} {string match a
}
2064 list [catch {foo
} msg
] $msg
2065 } {1 {wrong
# args: should be "string match ?-nocase? pattern string"}}
2066 test string-11.2
{string match
, too many args
} {
2067 proc foo
{} {string match a b c d
}
2068 list [catch {foo
} msg
] $msg
2069 } {1 {wrong
# args: should be "string match ?-nocase? pattern string"}}
2070 test string-11.3
{string match
} {
2071 proc foo
{} {string match abc abc
}
2074 #test string-11.4 {string match} {
2075 # proc foo {} {string mat abc abd}
2078 test string-11.5
{string match
} {
2079 proc foo
{} {string match ab
*c abc
}
2082 test string-11.6
{string match
} {
2083 proc foo
{} {string match ab
**c abc
}
2086 test string-11.7
{string match
} {
2087 proc foo
{} {string match ab
* abcdef
}
2090 test string-11.8
{string match
} {
2091 proc foo
{} {string match
*c abc
}
2094 test string-11.9
{string match
} {
2095 proc foo
{} {string match
*3*6*9 0123456789}
2098 test string-11.10
{string match
} {
2099 proc foo
{} {string match
*3*6*9 01234567890}
2102 test string-11.11
{string match
} {
2103 proc foo
{} {string match a?c abc
}
2106 test string-11.12
{string match
} {
2107 proc foo
{} {string match a??c abc
}
2110 test string-11.13
{string match
} {
2111 proc foo
{} {string match ?
1??
4???
8?
0123456789}
2114 test string-11.14
{string match
} {
2115 proc foo
{} {string match
{[abc
]bc
} abc
}
2118 test string-11.15
{string match
} {
2119 proc foo
{} {string match
{a
[abc
]c
} abc
}
2122 test string-11.16
{string match
} {
2123 proc foo
{} {string match
{a
[xyz
]c
} abc
}
2126 test string-11.17
{string match
} {
2127 proc foo
{} {string match
{12[2-7]45} 12345}
2130 test string-11.18
{string match
} {
2131 proc foo
{} {string match
{12[ab2-4cd
]45} 12345}
2134 test string-11.19
{string match
} {
2135 proc foo
{} {string match
{12[ab2-4cd
]45} 12b45
}
2138 test string-11.20
{string match
} {
2139 proc foo
{} {string match
{12[ab2-4cd
]45} 12d45
}
2142 test string-11.21
{string match
} {
2143 proc foo
{} {string match
{12[ab2-4cd
]45} 12145}
2146 test string-11.22
{string match
} {
2147 proc foo
{} {string match
{12[ab2-4cd
]45} 12545}
2150 test string-11.23
{string match
} {
2151 proc foo
{} {string match
{a
\*b
} a
*b
}
2154 test string-11.24
{string match
} {
2155 proc foo
{} {string match
{a
\*b
} ab
}
2158 test string-11.25
{string match
} {
2159 proc foo
{} {string match
{a
\*\?\[\]\\\x
} "a*?\[\]\\x"}
2162 test string-11.26
{string match
} {
2163 proc foo
{} {string match
** ""}
2166 test string-11.27
{string match
} {
2167 proc foo
{} {string match
*.
""}
2170 test string-11.28
{string match
} {
2171 proc foo
{} {string match
"" ""}
2174 test string-11.29
{string match
} {
2175 proc foo
{} {string match
\[a a
}
2178 test string-11.31
{string match case
} {
2179 proc foo
{} {string match a A
}
2182 test string-11.32
{string match nocase
} {
2183 proc foo
{} {string match
-n a A
}
2186 #test string-11.33 {string match nocase} {
2187 # proc foo {} {string match -nocase a\334 A\374}
2190 test string-11.34
{string match nocase
} {
2191 proc foo
{} {string match
-nocase a
*f ABCDEf
}
2194 test string-11.35
{string match case
, false hope
} {
2195 # This is true because '_' lies between the A-Z and a-z ranges
2196 proc foo
{} {string match
{[A-z
]} _
}
2199 test string-11.36
{string match nocase range
} {
2200 # This is false because although '_' lies between the A-Z and a-z ranges,
2201 # we lower case the end points before checking the ranges.
2202 proc foo
{} {string match
-nocase {[A-z
]} _
}
2205 test string-11.37
{string match nocase
} {
2206 proc foo
{} {string match
-nocase {[A-fh-Z
]} g
}
2209 test string-11.38
{string match case
, reverse range
} {
2210 proc foo
{} {string match
{[A-fh-Z
]} g
}
2213 test string-11.39
{string match
, *\ case
} {
2214 proc foo
{} {string match
{*\abc
} abc
}
2217 test string-11.40
{string match
, *special case
} {
2218 proc foo
{} {string match
{*[ab
]} abc
}
2221 test string-11.41
{string match
, *special case
} {
2222 proc foo
{} {string match
{*[ab
]*} abc
}
2225 #test string-11.42 {string match, *special case} {
2226 # proc foo {} {string match "*\\" "\\"}
2229 test string-11.43
{string match
, *special case
} {
2230 proc foo
{} {string match
"*\\\\" "\\"}
2233 test string-11.44
{string match
, *special case
} {
2234 proc foo
{} {string match
"*???" "12345"}
2237 test string-11.45
{string match
, *special case
} {
2238 proc foo
{} {string match
"*???" "12"}
2241 test string-11.46
{string match
, *special case
} {
2242 proc foo
{} {string match
"*\\*" "abc*"}
2245 test string-11.47
{string match
, *special case
} {
2246 proc foo
{} {string match
"*\\*" "*"}
2249 test string-11.48
{string match
, *special case
} {
2250 proc foo
{} {string match
"*\\*" "*abc"}
2253 test string-11.49
{string match
, *special case
} {
2254 proc foo
{} {string match
"?\\*" "a*"}
2257 #test string-11.50 {string match, *special case} {
2258 # proc foo {} {string match "\\" "\\"}
2264 test string-9.1
{string length
} {
2265 proc foo
{} {string length
}
2266 list [catch {foo
} msg
] $msg
2267 } {1 {wrong
# args: should be "string length string"}}
2268 test string-9.2
{string length
} {
2269 proc foo
{} {string length a b
}
2270 list [catch {foo
} msg
] $msg
2271 } {1 {wrong
# args: should be "string length string"}}
2272 test string-9.3
{string length
} {
2273 proc foo
{} {string length
"a little string"}
2279 test string-10.4
{string map
} {
2280 string map
{a b
} abba
2282 test string-10.5
{string map
} {
2285 test string-10.6
{string map
-nocase} {
2286 string map
-nocase {a b
} Abba
2288 test string-10.7
{string map
} {
2289 string map
{abc
321 ab
* a A
} aabcabaababcab
2291 test string-10.8
{string map
-nocase} {
2292 string map
-nocase {aBc
321 Ab
* a A
} aabcabaababcab
2294 test string-10.10
{string map
} {
2295 list [catch {string map
{a b c
} abba
} msg
] $msg
2296 } {1 {list must contain an even number of elements
}}
2297 test string-10.11
{string map
, nulls
} {
2298 string map
{\x00 NULL blah
\x00nix
} {qwerty
}
2300 test string-10.12
{string map
, unicode
} {
2301 string map
[list \374 ue UE
\334] "a\374ueUE\000EU"
2303 test string-10.13
{string map
, -nocase unicode
} {
2304 string map
-nocase [list \374 ue UE
\334] "a\374ueUE\000EU"
2306 test string-10.14
{string map
, -nocase null arguments
} {
2307 string map
-nocase {{} abc
} foo
2309 test string-10.15
{string map
, one pair case
} {
2310 string map
-nocase {abc
32} aAbCaBaAbAbcAb
2312 test string-10.16
{string map
, one pair case
} {
2313 string map
-nocase {ab
4321} aAbCaBaAbAbcAb
2314 } {a4321C4321a43214321c4321
}
2315 test string-10.17
{string map
, one pair case
} {
2316 string map
{Ab
4321} aAbCaBaAbAbcAb
2317 } {a4321CaBa43214321c4321
}
2318 test string-10.18
{string map
, empty argument
} {
2319 string map
-nocase {{} abc
} foo
2321 test string-10.19
{string map
, empty arguments
} {
2322 string map
-nocase {{} abc f bar
{} def
} foo
2325 ################################################################################
2327 ################################################################################
2329 test split-1.1
{basic
split commands
} {
2330 split "a\n b\t\r c\n "
2331 } {a
{} b
{} {} c
{} {}}
2332 test split-1.2
{basic
split commands
} {
2333 split "word 1xyzword 2zword 3" xyz
2334 } {{word
1} {} {} {word
2} {word
3}}
2335 test split-1.3
{basic
split commands
} {
2338 test split-1.4
{basic
split commands
} {
2339 split "a\}b\[c\{\]\$"
2340 } "a\\}b\\\[c\\{\\\]\\\$"
2341 test split-1.5
{basic
split commands
} {
2344 test split-1.6
{basic
split commands
} {
2347 test split-1.7
{basic
split commands
} {
2350 test split-1.8
{basic
split commands
} {
2353 foreach f
[split {]\n} {}] {
2360 test split-1.9
{basic
split commands
} {
2368 test split-1.10
{basic
split commands
} {
2369 split "a0ab1b2bbb3\000c4" ab
\000c
2370 } {{} 0 {} 1 2 {} {} 3 {} 4}
2371 test split-1.11
{basic
split commands
} {
2374 #test split-1.12 {basic split commands} {
2375 # split "\u0001ab\u0001cd\u0001\u0001ef\u0001" \1
2376 #} {{} ab cd {} ef {}}
2377 test split-1.13
{basic
split commands
} {
2378 split "12,34,56," {,}
2380 test split-1.14
{basic
split commands
} {
2381 split ",12,,,34,56," {,}
2382 } {{} 12 {} {} 34 56 {}}
2384 test split-2.1
{split errors
} {
2385 list [catch split msg
] $msg
2386 } {1 {wrong
# args: should be "split string ?splitChars?"}}
2387 test split-2.2
{split errors
} {
2388 list [catch {split a b c
} msg
] $msg
2389 } {1 {wrong
# args: should be "split string ?splitChars?"}}
2392 catch {rename foo
{}}
2394 ################################################################################
2396 ################################################################################
2398 test join-1.1
{basic
join commands
} {
2401 test join-1.2
{basic
join commands
} {
2404 test join-1.3
{basic
join commands
} {
2407 test join-1.4
{basic
join commands
} {
2411 test join-2.1
{join errors
} {
2412 list [catch join msg
] $msg
2413 } {1 {wrong
# args: should be "join list ?joinString?"}}
2414 test join-2.2
{join errors
} {
2415 list [catch {join a b c
} msg
] $msg
2416 } {1 {wrong
# args: should be "join list ?joinString?"}}
2417 #test join-2.3 {join errors} {
2418 # list [catch {join "a \{ c" 111} msg] $msg
2419 #} {1 {unmatched open brace in list}}
2421 test join-3.1
{joinString is
binary ok
} {
2422 string length
[join {a b c
} a
\0b
]
2425 test join-3.2
{join is
binary ok
} {
2426 string length
[join "a\0b a\0b a\0b"]
2429 ################################################################################
2431 ################################################################################
2433 test switch-1.1
{simple patterns
} {
2434 switch a a
{expr 1} b
{expr 2} c
{expr 3} default {expr 4}
2436 test switch-1.2
{simple patterns
} {
2437 switch b a
{expr 1} b
{expr 2} c
{expr 3} default {expr 4}
2439 test switch-1.3
{simple patterns
} {
2440 switch x a
{expr 1} b
{expr 2} c
{expr 3} default {expr 4}
2442 test switch-1.4
{simple patterns
} {
2443 switch x a
{expr 1} b
{expr 2} c
{expr 3}
2445 test switch-1.5
{simple pattern matches many times
} {
2446 switch b a
{expr 1} b
{expr 2} b
{expr 3} b
{expr 4}
2448 test switch-1.6
{simple patterns
} {
2449 switch default a
{expr 1} default {expr 2} c
{expr 3} default {expr 4}
2451 test switch-1.7
{simple patterns
} {
2452 switch x a
{expr 1} default {expr 2} c
{expr 3} default {expr 4}
2455 test switch-2.1
{single-argument form
for pattern
/command pairs
} {
2462 test switch-2.2
{single-argument form
for pattern
/command pairs
} {
2463 list [catch {switch z
{a
2 b
}}]
2466 test switch-3.1
{-exact vs.
-glob vs.
-regexp} {
2467 switch -exact aaaab
{
2468 ^a
*b
$ {concat regexp}
2470 aaaab
{concat exact
}
2471 default {concat none
}
2474 test switch-3.2
{-exact vs.
-glob vs.
-regexp (no
[regexp] cmd
)} {
2475 rename regexp regexp.none
2477 switch -regexp aaaab
{
2478 ^a
*b
$ {concat regexp}
2480 aaaab
{concat exact
}
2481 default {concat none
}
2484 rename regexp.none
regexp
2488 test switch-3.3
{-exact vs.
-glob vs.
-regexp (with
[regexp] cmd
)} {
2489 switch -regexp aaaab
{
2490 ^a
*b
$ {concat regexp}
2492 aaaab
{concat exact
}
2493 default {concat none
}
2496 test switch-3.4
{-exact vs.
-glob vs.
-regexp} {
2497 switch -glob aaaab
{
2498 ^a
*b
$ {concat regexp}
2500 aaaab
{concat exact
}
2501 default {concat none
}
2504 test switch-3.5
{-exact vs.
-glob vs.
-regexp} {
2505 switch aaaab
{^a
*b
$} {concat regexp} *b
{concat glob} \
2506 aaaab
{concat exact
} default {concat none
}
2508 test switch-3.6
{-exact vs.
-glob vs.
-regexp} {
2510 ^g.
*b
$ {concat regexp}
2512 -glob {concat exact
}
2513 default {concat none
}
2516 test switch-3.7
{-exact vs.
-glob vs.
-regexp} {
2517 list [catch {switch -foo a b c
} msg
] $msg
2518 } {1 {bad
option "-foo": must be
-exact, -glob, -regexp, -command procname or
--}}
2520 test switch-4.1
{error in executed command
} {
2521 list [catch {switch a a
{error "Just a test"} default {expr 1}} msg
] \
2524 test switch-4.2
{error: not enough args
} {
2527 test switch-4.3
{error: pattern with no body
} {
2530 test switch-4.4
{error: pattern with no body
} {
2531 catch {switch a b
{expr 1} c
}
2533 test switch-4.5
{error in
default command
} {
2534 list [catch {switch foo a
{error switch1
} b
{error switch 3} \
2535 default {error switch2
}} msg
] $msg
2538 #~ test switch-5.1 {errors in -regexp matching} {
2539 #~ list [catch {switch -regexp aaaab {
2541 #~ aaaab {concat exact}
2542 #~ default {concat none}
2544 #~ } {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
2546 test switch-6.1
{backslashes in patterns
} {
2547 switch -exact {\a\$\.
\[} {
2548 \a\$\.
\[ {concat first
}
2549 \a\\$\.
\\[ {concat second
}
2550 \\a
\\$\\.
\\[ {concat third
}
2551 {\a\\$\.
\\[} {concat fourth
}
2552 {\\a
\\$\\.
\\[} {concat fifth
}
2553 default {concat none
}
2556 test switch-6.2
{backslashes in patterns
} {
2557 switch -exact {\a\$\.
\[} {
2558 \a\$\.
\[ {concat first
}
2559 {\a\$\.
\[} {concat second
}
2560 {{\a\$\.
\[}} {concat third
}
2561 default {concat none
}
2565 test switch-7.1
{"-" bodies
} {
2573 test switch-7.2
{"-" bodies
} {
2581 } {1 {no body specified
for pattern
"c"}}
2582 # Following original Tcl test makes no sense, I feel! Please review ...
2583 #~ test switch-7.3 {"-" bodies} {
2591 #~ } {1 {no body specified for pattern "c"}}
2592 test switch-7.3
{"-" bodies
} {
2600 } {1 {invalid command name
"-foo"}}
2602 test switch-8.1
{empty body
} {
2611 test switch-9.1
{empty pattern
/body
list} {
2614 test switch-9.2
{empty pattern
/body
list} {
2617 test switch-9.3
{empty pattern
/body
list} {
2620 test switch-9.4
{empty pattern
/body
list} {
2621 catch {switch -- x
{}}
2623 test switch-9.5
{unpaired pattern
} {
2624 catch {switch x a
{} b
}
2626 test switch-9.6
{unpaired pattern
} {
2627 catch {switch x
{a
{} b
}}
2629 test switch-9.7
{unpaired pattern
} {
2630 catch {switch x a
{} # comment b}
2632 test switch-9.8
{unpaired pattern
} {
2633 catch {switch x
{a
{} # comment b}}
2635 test switch-9.9
{unpaired pattern
} {
2636 catch {switch x a
{} x
{} # comment b}
2638 test switch-9.10
{unpaired pattern
} {
2639 catch {switch x
{a
{} x
{} # comment b}}
2642 test switch-10.1
{no callback given to
-command} {
2643 catch {switch -command a
{ a
{expr 1} b
{expr 2} }}
2645 test switch-10.2
{callback expect wrong
# args for -command} {
2646 catch {switch -command [lambda
{p1
} {expr 1}] a
{ a
{expr 1} b
{expr 2} }}
2648 test switch-10.3
{callback to
-command returns ever
0: no match
} {
2649 switch -command [lambda
{p1 p2
} {expr 0}] a a
{expr 1} b
{expr 2}
2651 test switch-10.4
{callback to
-command returns
3 at first match
} {
2652 switch -command [lambda
{p1 p2
} {expr 3}] a a
{expr 1} b
{expr 2}
2654 test switch-10.5
{[error] in callback to
-command} {
2656 switch -command [lambda
{p1 p2
} {error "foo"}] a a
{expr 1} b
{expr 2}
2659 test switch-10.6
{[continue] in callback to
-command} {
2661 switch -command [lambda
{p1 p2
} {continue}] a a
{expr 1} b
{expr 2}
2664 test switch-10.7
{callback matches first
if pat
< str
} {
2665 switch -command [lambda
{pat str
} {expr {$pat < $str}}] 3 \
2666 5 {expr 1} 3 {expr 2}
2668 test switch-10.8
{callback matches first
if pat
< str
} {
2669 switch -command [lambda
{pat str
} {expr {$pat < $str}}] 7 \
2670 5 {expr 1} 3 {expr 2}
2672 test switch-10.9
{callback matches first
if pat
< str
} {
2673 switch -command [lambda
{pat str
} {expr {$pat < $str}}] 4 \
2674 5 {expr 1} 3 {expr 2}
2677 ################################################################################
2679 ################################################################################
2681 # Basic "for" operation.
2683 test for-1.1
{TclCompileForCmd
: missing initial command
} {
2684 list [catch {for} msg
] $msg
2685 } {1 {wrong
# args: should be "for start test next body"}}
2686 test for-1.2
{TclCompileForCmd
: error in initial command
} {
2687 list [catch {for {set}} msg
] $msg
2688 } {1 {wrong
# args: should be "for start test next body"}}
2690 test for-1.3
{TclCompileForCmd
: missing test expression
} {
2691 catch {for {set i
0}} msg
2693 } {wrong
# args: should be "for start test next body"}
2694 test for-1.5
{TclCompileForCmd
: test expression is enclosed in quotes
} {
2696 for {} "$i > 5" {incr i
} {}
2698 test for-1.6
{TclCompileForCmd
: missing
"next" command
} {
2699 catch {for {set i
0} {$i < 5}} msg
2701 } {wrong
# args: should be "for start test next body"}
2702 test for-1.7
{TclCompileForCmd
: missing command body
} {
2703 catch {for {set i
0} {$i < 5} {incr i
}} msg
2705 } {wrong
# args: should be "for start test next body"}
2707 test for-1.9
{TclCompileForCmd
: simple command body
} {
2709 for {set i
1} {$i<6} {set i
[expr $i+1]} {
2711 set a
[concat $a $i]
2715 test for-1.10
{TclCompileForCmd
: command body in quotes
} {
2717 for {set i
1} {$i<6} {set i
[expr $i+1]} "append a x"
2720 test for-1.11
{TclCompileForCmd
: computed command body
} {
2724 set x1
{append a x1
; }
2726 set x2
{; append a x2
}
2728 for {set i
1} {$i<6} {set i
[expr $i+1]} $x1$bb$x2
2731 test for-1.13
{TclCompileForCmd
: long command body
} {
2733 for {set i
1} {$i<6} {set i
[expr $i+1]} {
2736 set tcl_platform
(machine
) i686
2737 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2738 catch {set a
$a} msg
2739 catch {incr i
5} msg
2740 catch {incr i
-5} msg
2742 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2743 catch {set a
$a} msg
2744 catch {incr i
5} msg
2745 catch {incr i
-5} msg
2747 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2748 catch {set a
$a} msg
2749 catch {incr i
5} msg
2750 catch {incr i
-5} msg
2752 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2753 catch {set a
$a} msg
2754 catch {incr i
5} msg
2755 catch {incr i
-5} msg
2757 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2758 catch {set a
$a} msg
2759 catch {incr i
5} msg
2760 catch {incr i
-5} msg
2762 set a
[concat $a $i]
2766 test for-1.14
{TclCompileForCmd
: for command result
} {
2767 set a
[for {set i
0} {$i < 5} {incr i
} {}]
2770 test for-1.15
{TclCompileForCmd
: for command result
} {
2771 set a
[for {set i
0} {$i < 5} {incr i
} {if $i==3 break}]
2775 # Check "for" and "continue".
2777 test for-2.1
{TclCompileContinueCmd
: arguments
after "continue"} {
2778 catch {continue foo
} msg
2780 } {wrong
# args: should be "continue"}
2781 test for-2.2
{TclCompileContinueCmd
: continue result
} {
2784 test for-2.3
{continue tests
} {
2786 for {set i
1} {$i <= 4} {set i
[expr $i+1]} {
2787 if {$i == 2} continue
2788 set a
[concat $a $i]
2792 test for-2.4
{continue tests
} {
2794 for {set i
1} {$i <= 4} {set i
[expr $i+1]} {
2795 if {$i != 2} continue
2796 set a
[concat $a $i]
2800 test for-2.5
{continue tests
, nested loops
} {
2802 for {set i
1} {$i <= 4} {incr i
} {
2803 for {set a
1} {$a <= 2} {incr a
} {
2804 if {$i>=2 && $a>=2} continue
2805 set msg
[concat $msg "$i.$a"]
2809 } {1.1 1.2 2.1 3.1 4.1}
2810 test for-2.6
{continue tests
, long command body
} {
2812 for {set i
1} {$i<6} {set i
[expr $i+1]} {
2816 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2817 catch {set a
$a} msg
2818 catch {incr i
5} msg
2819 catch {incr i
-5} msg
2821 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2822 catch {set a
$a} msg
2823 catch {incr i
5} msg
2824 catch {incr i
-5} msg
2826 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2827 catch {set a
$a} msg
2828 catch {incr i
5} msg
2829 catch {incr i
-5} msg
2831 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2832 catch {set a
$a} msg
2833 catch {incr i
5} msg
2834 catch {incr i
-5} msg
2836 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2837 catch {set a
$a} msg
2838 catch {incr i
5} msg
2839 catch {incr i
-5} msg
2841 set a
[concat $a $i]
2846 # Check "for" and "break".
2848 test for-3.1
{TclCompileBreakCmd
: arguments
after "break"} {
2849 catch {break foo
} msg
2851 } {wrong
# args: should be "break"}
2852 test for-3.2
{TclCompileBreakCmd
: break result
} {
2855 test for-3.3
{break tests
} {
2857 for {set i
1} {$i <= 4} {incr i
} {
2859 set a
[concat $a $i]
2863 test for-3.4
{break tests
, nested loops
} {
2865 for {set i
1} {$i <= 4} {incr i
} {
2866 for {set a
1} {$a <= 2} {incr a
} {
2867 if {$i>=2 && $a>=2} break
2868 set msg
[concat $msg "$i.$a"]
2872 } {1.1 1.2 2.1 3.1 4.1}
2873 test for-3.5
{break tests
, long command body
} {
2875 for {set i
1} {$i<6} {set i
[expr $i+1]} {
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 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2885 catch {set a
$a} msg
2886 catch {incr i
5} msg
2887 catch {incr i
-5} msg
2889 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2890 catch {set a
$a} msg
2891 catch {incr i
5} msg
2892 catch {incr i
-5} msg
2895 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2896 catch {set a
$a} msg
2897 catch {incr i
5} msg
2898 catch {incr i
-5} msg
2900 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
2901 catch {set a
$a} msg
2902 catch {incr i
5} msg
2903 catch {incr i
-5} msg
2905 set a
[concat $a $i]
2909 test for-4.1
{break must reset the
interp result
} {
2911 set z GLOBTESTDIR
/dir2
/file2.c
2912 if [string match GLOBTESTDIR
/dir2
/* $z] {
2919 # Test for incorrect "double evaluation" semantics
2921 test for-5.1
{possible delayed substitution of increment command
} {
2922 # Increment should be 5, and lappend should always append $a
2927 for {set a
1} {$a < 12} "incr a $a" {lappend i
$a}
2931 test for-5.2
{possible delayed substitution of increment command
} {
2932 # Increment should be 5, and lappend should always append $a
2937 for {set a
1} {$a < 12} "incr a $a" {lappend i
$a}
2942 test for-5.3
{possible delayed substitution of body command
} {
2943 # Increment should be $a, and lappend should always append 5
2946 for {set a
1} {$a < 12} {incr a
$a} "lappend i $a"
2949 test for-5.4
{possible delayed substitution of body command
} {
2950 # Increment should be $a, and lappend should always append 5
2955 for {set a
1} {$a < 12} {incr a
$a} "lappend i $a"
2961 # In the following tests we need to bypass the bytecode compiler by
2962 # substituting the command from a variable. This ensures that command
2963 # procedure is invoked directly.
2965 test for-6.1
{Tcl_ForObjCmd
: number of args
} {
2969 } {wrong
# args: should be "for start test next body"}
2970 test for-6.2
{Tcl_ForObjCmd
: number of args
} {
2972 catch {$z {set i
0}} msg
2974 } {wrong
# args: should be "for start test next body"}
2975 test for-6.3
{Tcl_ForObjCmd
: number of args
} {
2977 catch {$z {set i
0} {$i < 5}} msg
2979 } {wrong
# args: should be "for start test next body"}
2980 test for-6.4
{Tcl_ForObjCmd
: number of args
} {
2982 catch {$z {set i
0} {$i < 5} {incr i
}} msg
2984 } {wrong
# args: should be "for start test next body"}
2985 test for-6.5
{Tcl_ForObjCmd
: number of args
} {
2987 catch {$z {set i
0} {$i < 5} {incr i
} {body
} extra
} msg
2989 } {wrong
# args: should be "for start test next body"}
2990 test for-6.6
{Tcl_ForObjCmd
: error in initial command
} {
2992 list [catch {$z {set} {$i < 5} {incr i
} {body
}} msg
] $msg
2993 } {1 {wrong
# args: should be "set varName ?newValue?"}}
2994 test for-6.8
{Tcl_ForObjCmd
: test expression is enclosed in quotes
} {
2997 $z {set i
6} "$i > 5" {incr i
} {set y
$i}
3000 test for-6.10
{Tcl_ForObjCmd
: simple command body
} {
3003 $z {set i
1} {$i<6} {set i
[expr $i+1]} {
3005 set a
[concat $a $i]
3009 test for-6.11
{Tcl_ForObjCmd
: command body in quotes
} {
3012 $z {set i
1} {$i<6} {set i
[expr $i+1]} "append a x"
3015 test for-6.12
{Tcl_ForObjCmd
: computed command body
} {
3020 set x1
{append a x1
; }
3022 set x2
{; append a x2
}
3024 $z {set i
1} {$i<6} {set i
[expr $i+1]} $x1$bb$x2
3027 test for-6.14
{Tcl_ForObjCmd
: long command body
} {
3030 $z {set i
1} {$i<6} {set i
[expr $i+1]} {
3033 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
3034 catch {set a
$a} msg
3035 catch {incr i
5} msg
3036 catch {incr i
-5} msg
3038 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
3039 catch {set a
$a} msg
3040 catch {incr i
5} msg
3041 catch {incr i
-5} msg
3043 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
3044 catch {set a
$a} msg
3045 catch {incr i
5} msg
3046 catch {incr i
-5} msg
3048 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
3049 catch {set a
$a} msg
3050 catch {incr i
5} msg
3051 catch {incr i
-5} msg
3053 if {$i>6 && $tcl_platform(machine
) eq
"xxx"} {
3054 catch {set a
$a} msg
3055 catch {incr i
5} msg
3056 catch {incr i
-5} msg
3058 set a
[concat $a $i]
3062 test for-6.15
{Tcl_ForObjCmd
: for command result
} {
3064 set a
[$z {set i
0} {$i < 5} {incr i
} {}]
3067 test for-6.16
{Tcl_ForObjCmd
: for command result
} {
3069 set a
[$z {set i
0} {$i < 5} {incr i
} {if $i==3 break}]
3073 ################################################################################
3075 ################################################################################
3077 test info-1.1
{info body
option} {
3078 proc t1
{} {body of t1
}
3081 test info-1.2
{info body
option} {
3082 list [catch {info body
set} msg
] $msg
3083 } {1 {command
"set" is not a procedure
}}
3084 test info-1.3
{info body
option} {
3085 list [catch {info args
set 1} msg
] $msg
3086 } {1 {wrong
# args: should be "info args procname"}}
3087 test info-1.5
{info body
option, returning bytecompiled bodies
} {
3092 return "variable $v existence: [info exists var]"
3096 list [catch [info body foo
] msg
] $msg
3097 } {1 {can't
read "args": no such
variable}}
3098 test info-1.6
{info body
option, returning
list bodies
} {
3099 proc foo args
[list subst bar
]
3100 list [string length
[info body foo
]] \
3101 [foo
; string length
[info body foo
]]
3103 test info-2.1
{info commands
option} {
3106 set x
" [info commands] "
3107 list [string match
{* t1
*} $x] [string match
{* t2
*} $x] \
3108 [string match
{* set *} $x] [string match
{* list *} $x]
3110 test info-2.2
{info commands
option} {
3113 set x
[info commands
]
3114 string match
{* t1
*} $x
3116 test info-2.3
{info commands
option} {
3121 test info-2.4
{info commands
option} {
3124 lsort [info commands _t
*]
3126 catch {rename _t1_
{}}
3127 catch {rename _t2_
{}}
3128 test info-2.5
{info commands
option} {
3129 list [catch {info commands a b
} msg
] $msg
3130 } {1 {wrong
# args: should be "info commands ?pattern?"}}
3131 test info-3.1
{info exists
option} {
3135 catch {unset _nonexistent_
}
3136 test info-3.2
{info exists
option} {
3137 info exists _nonexistent_
3139 test info-3.3
{info exists
option} {
3140 proc t1
{x
} {return [info exists x
]}
3143 test info-3.4
{info exists
option} {
3145 global _nonexistent_
3146 return [info exists _nonexistent_
]
3150 test info-3.5
{info exists
option} {
3153 return [info exists y
]
3157 test info-3.6
{info exists
option} {
3158 proc t1
{x
} {return [info exists value
]}
3161 test info-3.7
{info exists
option} {
3164 list [info exists x
] [info exists x
(1)] [info exists x
(2)]
3167 test info-3.8
{info exists
option} {
3168 list [catch {info exists
} msg
] $msg
3169 } {1 {wrong
# args: should be "info exists varName"}}
3170 test info-3.9
{info exists
option} {
3171 list [catch {info exists
1 2} msg
] $msg
3172 } {1 {wrong
# args: should be "info exists varName"}}
3173 test info-4.1
{info globals
option} {
3177 set a
" [info globals] "
3178 list [string match
{* x
*} $a] [string match
{* y
*} $a] \
3179 [string match
{* value
*} $a] [string match
{* _foobar_
*} $a]
3181 test info-4.2
{info globals
option} {
3184 lsort [info globals _xxx
*]
3186 test info-4.3
{info globals
option} {
3187 list [catch {info globals
1 2} msg
] $msg
3188 } {1 {wrong
# args: should be "info globals ?pattern?"}}
3189 test info-5.1
{info level
option} {
3193 test info-5.2
{info level
option} {
3196 set y
[info level
1]
3200 } {1 {t1
146 testString
}}
3201 test info-5.3
{info level
option} {
3206 list [info level
] [info level
1] [info level
2] [info level
-1] \
3209 t1
146 {a
{b c
} {{{c
}}}}
3210 } {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
}}}}}}
3211 test info-5.4
{info level
option} {
3214 set y
[info level
1]
3219 test info-5.5
{info level
option} {
3220 list [catch {info level
1 2} msg
] $msg
3221 } {1 {wrong
# args: should be "info level ?levelNum?"}}
3222 test info-5.6
{info level
option} {
3223 list [catch {info level
123a
} msg
] $msg
3224 } {1 {bad level
"123a"}}
3225 test info-5.7
{info level
option} {
3226 list [catch {info level
0} msg
] $msg
3227 } {1 {bad level
"0"}}
3228 test info-5.8
{info level
option} {
3229 proc t1
{} {info level
-1}
3230 list [catch {t1
} msg
] $msg
3231 } {1 {bad level
"-1"}}
3232 test info-5.9
{info level
option} {
3233 proc t1
{x
} {info level
$x}
3234 list [catch {t1
-3} msg
] $msg
3235 } {1 {bad level
"-3"}}
3236 test info-6.1
{info locals
option} {
3244 return [info locals
]
3248 test info-6.2
{info locals
option} {
3253 return [info locals x
*]
3257 test info-6.3
{info locals
option} {
3258 list [catch {info locals
1 2} msg
] $msg
3259 } {1 {wrong
# args: should be "info locals ?pattern?"}}
3260 test info-6.4
{info locals
option} {
3263 test info-6.5
{info locals
option} {
3264 proc t1
{} {return [info locals
]}
3267 test info-6.6
{info locals vs
unset compiled locals
} {
3269 foreach $lst $lst {}
3271 return [info locals
]
3273 lsort [t1
{a b c c d e f
}]
3275 test info-6.7
{info locals with temporary variables
} {
3282 test info-7.1
{info vars
option} {
3292 test info-7.2
{info vars
option} {
3298 return [info vars x
*]
3302 test info-7.3
{info vars
option} {
3304 } [lsort [info globals
]]
3305 test info-7.4
{info vars
option} {
3306 list [catch {info vars a b
} msg
] $msg
3307 } {1 {wrong
# args: should be "info vars ?pattern?"}}
3308 test info-7.5
{info vars with temporary variables
} {
3317 ################################################################################
3319 ################################################################################
3321 test linsert-1.1
{linsert command
} {
3322 linsert {1 2 3 4 5} 0 a
3324 test linsert-1.2
{linsert command
} {
3325 linsert {1 2 3 4 5} 1 a
3327 test linsert-1.3
{linsert command
} {
3328 linsert {1 2 3 4 5} 2 a
3330 test linsert-1.4
{linsert command
} {
3331 linsert {1 2 3 4 5} 3 a
3333 test linsert-1.5
{linsert command
} {
3334 linsert {1 2 3 4 5} 4 a
3336 test linsert-1.6
{linsert command
} {
3337 linsert {1 2 3 4 5} 5 a
3339 test linsert-1.7
{linsert command
} {
3340 linsert {1 2 3 4 5} 2 one two
\{three
\$four
3341 } {1 2 one two
\{three
{$four} 3 4 5}
3342 test linsert-1.8
{linsert command
} {
3343 linsert {\{one
\$two \{three
\ four
\ five
} 2 a b c
3344 } {\{one
{$two} a b c
\{three
{ four
} { five
}}
3345 test linsert-1.9
{linsert command
} {
3346 linsert {{1 2} {3 4} {5 6} {7 8}} 2 {x y
} {a b
}
3347 } {{1 2} {3 4} {x y
} {a b
} {5 6} {7 8}}
3348 test linsert-1.10
{linsert command
} {
3351 test linsert-1.11
{linsert command
} {
3354 test linsert-1.12
{linsert command
} {
3355 linsert {a b
"c c" d e
} 3 1
3357 test linsert-1.13
{linsert command
} {
3358 linsert { a b c d
} 0 1 2
3360 test linsert-1.14
{linsert command
} {
3361 linsert {a b c
{d e f
}} 4 1 2
3362 } {a b c
{d e f
} 1 2}
3363 test linsert-1.15
{linsert command
} {
3364 linsert {a b c
\{\ abc
} 4 q r
3365 } {a b c
\{\ q r abc
}
3366 test linsert-1.16
{linsert command
} {
3367 linsert {a b c
\{ abc
} 4 q r
3368 } {a b c
\{ q r abc
}
3369 test linsert-1.17
{linsert command
} {
3370 linsert {a b c
} end q r
3372 test linsert-1.18
{linsert command
} {
3375 test linsert-1.19
{linsert command
} {
3378 test linsert-1.20
{linsert command
, use of end-int index
} {
3379 linsert {a b c d
} end-2 e f
3382 test linsert-2.1
{linsert errors
} {
3383 list [catch linsert msg
] $msg
3384 } {1 {wrong
# args: should be "linsert list index element ?element ...?"}}
3385 test linsert-2.2
{linsert errors
} {
3386 list [catch {linsert a b
} msg
] $msg
3387 } {1 {wrong
# args: should be "linsert list index element ?element ...?"}}
3388 test linsert-2.3
{linsert errors
} {
3389 list [catch {linsert a
12x
2} msg
] $msg
3390 } {1 {bad index
"12x": must be integer?
[+-]integer? or end?
[+-]integer?
}}
3392 test linsert-3.1
{linsert won't modify shared argument objects
} {
3394 linsert "a b c" 1 "x y"
3399 test linsert-3.2
{linsert won't modify shared argument objects
} {
3401 set lis
[concat a
\"b
\" c
]
3402 linsert $lis 0 [string length
$lis]
3405 ################################################################################
3407 ################################################################################
3409 test lreplace-1.1
{lreplace command
} {
3410 lreplace {1 2 3 4 5} 0 0 a
3412 test lreplace-1.2
{lreplace command
} {
3413 lreplace {1 2 3 4 5} 1 1 a
3415 test lreplace-1.3
{lreplace command
} {
3416 lreplace {1 2 3 4 5} 2 2 a
3418 test lreplace-1.4
{lreplace command
} {
3419 lreplace {1 2 3 4 5} 3 3 a
3421 test lreplace-1.5
{lreplace command
} {
3422 lreplace {1 2 3 4 5} 4 4 a
3424 test lreplace-1.6
{lreplace command
} {
3425 lreplace {1 2 3 4 5} 4 5 a
3427 test lreplace-1.7
{lreplace command
} {
3428 lreplace {1 2 3 4 5} -1 -1 a
3430 test lreplace-1.8
{lreplace command
} {
3431 lreplace {1 2 3 4 5} 2 end a b c d
3433 test lreplace-1.9
{lreplace command
} {
3434 lreplace {1 2 3 4 5} 0 3
3436 test lreplace-1.10
{lreplace command
} {
3437 lreplace {1 2 3 4 5} 0 4
3439 test lreplace-1.11
{lreplace command
} {
3440 lreplace {1 2 3 4 5} 0 1
3442 test lreplace-1.12
{lreplace command
} {
3443 lreplace {1 2 3 4 5} 2 3
3445 test lreplace-1.13
{lreplace command
} {
3446 lreplace {1 2 3 4 5} 3 end
3448 test lreplace-1.14
{lreplace command
} {
3449 lreplace {1 2 3 4 5} -1 4 a b c
3451 test lreplace-1.15
{lreplace command
} {
3452 lreplace {a b
"c c" d e f
} 3 3
3454 test lreplace-1.16
{lreplace command
} {
3455 lreplace { 1 2 3 4 5} 0 0 a
3457 test lreplace-1.17
{lreplace command
} {
3458 lreplace {1 2 3 4 "5 6"} 4 4 a
3460 test lreplace-1.18
{lreplace command
} {
3461 lreplace {1 2 3 4 {5 6}} 4 4 a
3463 test lreplace-1.19
{lreplace command
} {
3464 lreplace {1 2 3 4} 2 end x y z
3466 test lreplace-1.20
{lreplace command
} {
3467 lreplace {1 2 3 4} end end a
3469 test lreplace-1.21
{lreplace command
} {
3470 lreplace {1 2 3 4} end
3 a
3472 test lreplace-1.22
{lreplace command
} {
3473 lreplace {1 2 3 4} end end
3475 test lreplace-1.23
{lreplace command
} {
3476 lreplace {1 2 3 4} 2 -1 xy
3478 test lreplace-1.24
{lreplace command
} {
3479 lreplace {1 2 3 4} end
-1 z
3481 test lreplace-1.25
{lreplace command
} {
3482 concat \"[lreplace {\}\ hello
} end end
]\"
3484 test lreplace-1.26
{lreplace command
} {
3487 list [set foo
[lreplace $foo end end
]] \
3488 [set foo
[lreplace $foo end end
]] \
3489 [set foo
[lreplace $foo end end
]]
3493 test lreplace-2.1
{lreplace errors
} {
3494 list [catch lreplace msg
] $msg
3495 } {1 {wrong
# args: should be "lreplace list first last ?element element ...?"}}
3496 test lreplace-2.2
{lreplace errors
} {
3497 list [catch {lreplace a b
} msg
] $msg
3498 } {1 {wrong
# args: should be "lreplace list first last ?element element ...?"}}
3499 test lreplace-2.3
{lreplace errors
} {
3500 list [catch {lreplace x a
10} msg
] $msg
3501 } {1 {bad index
"a": must be integer?
[+-]integer? or end?
[+-]integer?
}}
3502 test lreplace-2.4
{lreplace errors
} {
3503 list [catch {lreplace x
10 x
} msg
] $msg
3504 } {1 {bad index
"x": must be integer?
[+-]integer? or end?
[+-]integer?
}}
3505 test lreplace-2.5
{lreplace errors
} {
3506 list [catch {lreplace x
10 1x
} msg
] $msg
3507 } {1 {bad index
"1x": must be integer?
[+-]integer? or end?
[+-]integer?
}}
3508 test lreplace-2.6
{lreplace errors
} {
3509 list [catch {lreplace x
3 2} msg
] $msg
3510 } {1 {list doesn't contain element
3}}
3511 test lreplace-2.7
{lreplace errors
} {
3512 list [catch {lreplace x
1 1} msg
] $msg
3513 } {1 {list doesn't contain element
1}}
3515 test lreplace-3.1
{lreplace won't modify shared argument objects
} {
3517 lreplace "a b c" 1 1 "x y"
3523 ################################################################################
3525 ################################################################################
3527 test lrange-1.1
{range of
list elements
} {
3528 lrange {a b c d
} 1 2
3530 test lrange-1.2
{range of
list elements
} {
3531 lrange {a
{bcd e
{f g
{}}} l14 l15 d
} 1 1
3532 } {{bcd e
{f g
{}}}}
3533 test lrange-1.3
{range of
list elements
} {
3534 lrange {a
{bcd e
{f g
{}}} l14 l15 d
} 3 end
3536 test lrange-1.4
{range of
list elements
} {
3537 lrange {a
{bcd e
{f g
{}}} l14 l15 d
} 4 10000
3539 test lrange-1.5
{range of
list elements
} {
3540 lrange {a
{bcd e
{f g
{}}} l14 l15 d
} 4 3
3542 test lrange-1.6
{range of
list elements
} {
3543 lrange {a
{bcd e
{f g
{}}} l14 l15 d
} 10 11
3545 test lrange-1.7
{range of
list elements
} {
3546 lrange {a b c d e
} -1 2
3548 test lrange-1.8
{range of
list elements
} {
3549 lrange {a b c d e
} -2 -1
3551 test lrange-1.9
{range of
list elements
} {
3552 lrange {a b c d e
} -2 end
3554 test lrange-1.10
{range of
list elements
} {
3555 lrange "a b\{c d" 1 2
3557 test lrange-1.11
{range of
list elements
} {
3558 lrange "a b c d" end end
3560 test lrange-1.12
{range of
list elements
} {
3561 lrange "a b c d" end
100000
3563 test lrange-1.13
{range of
list elements
} {
3564 lrange "a b c d" end
3
3566 test lrange-1.14
{range of
list elements
} {
3567 lrange "a b c d" end
2
3569 test lrange-1.15
{range of
list elements
} {
3570 concat \"[lrange {a b
\{\ } 0 2]"
3572 test lrange-1.16 {list element quoting} {
3573 lrange {[append a .b]} 0 end
3574 } {{[append} a .b\]}
3576 test lrange-2.1 {error conditions} {
3577 list [catch {lrange a b} msg] $msg
3578 } {1 {wrong # args: should be "lrange list first last
"}}
3579 test lrange-2.2 {error conditions} {
3580 list [catch {lrange a b 6 7} msg] $msg
3581 } {1 {wrong # args: should be "lrange list first last
"}}
3582 test lrange-2.3 {error conditions} {
3583 list [catch {lrange a b 6} msg] $msg
3584 } {1 {bad index "b
": must be integer?[+-]integer? or end?[+-]integer?}}
3585 test lrange-2.4 {error conditions} {
3586 list [catch {lrange a 0 enigma} msg] $msg
3587 } {1 {bad index "enigma
": must be integer?[+-]integer? or end?[+-]integer?}}
3588 #test lrange-2.5 {error conditions} {
3589 # list [catch {lrange "a
\{b c
" 3 4} msg] $msg
3590 #} {1 {unmatched open brace in list}}
3591 #test lrange-2.6 {error conditions} {
3592 # list [catch {lrange "a b c
\{ d e
" 1 4} msg] $msg
3593 #} {1 {unmatched open brace in list}}
3595 ################################################################################
3597 ################################################################################
3599 test regexp-1.1 {basic regexp operation} {
3603 test regexp-1.2 {basic regexp operation} {
3607 test regexp-1.3 {basic regexp operation} {
3611 test regexp-1.4 {basic regexp operation} {
3612 regexp -- -gorp abc-gorpxxx
3615 test regexp-1.5 {basic regexp operation} {
3616 regexp {^([^ ]*)[ ]*([^ ]*)} "" a
3619 # This null case doesn't work with some regex libraries
3621 #test regexp-1.6 {basic regexp operation} {
3622 # list [catch {regexp {} abc} msg] $msg
3625 test regexp-2.1 {getting substrings back from regexp} {
3627 list [regexp ab*c abbbbc foo] $foo
3630 test regexp-2.2 {getting substrings back from regexp} {
3633 list [regexp a(b*)c abbbbc foo f2] $foo $f2
3636 test regexp-2.3 {getting substrings back from regexp} {
3639 list [regexp a(b*)(c) abbbbc foo f2] $foo $f2
3642 test regexp-2.4 {getting substrings back from regexp} {
3646 list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
3649 test regexp-2.5 {getting substrings back from regexp} {
3650 set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
3651 set f6 {}; set f7 {}; set f8 {}; set f9 {}; set fa {}; set fb {};
3652 list [regexp (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*)(a*)(b*) \
3653 12223345556789999aabbb \
3654 foo f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb] $foo $f1 $f2 $f3 $f4 $f5 \
3655 $f6 $f7 $f8 $f9 $fa $fb
3656 } {1 12223345556789999aabbb 1 222 33 4 555 6 7 8 9999 aa bbb}
3658 test regexp-2.6 {getting substrings back from regexp} {
3659 set foo 2; set f2 2; set f3 2; set f4 2
3660 list [regexp (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
3663 test regexp-2.7 {getting substrings back from regexp} {
3664 set foo 1; set f2 1; set f3 1; set f4 1
3665 list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
3668 test regexp-2.8 {getting substrings back from regexp} {
3670 list [regexp {^a*b} aaaab match] $match
3673 test regexp-3.1 {-indices option to regexp} {
3675 list [regexp -indices ab*c abbbbc foo] $foo
3678 test regexp-3.2 {-indices option to regexp} {
3681 list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2
3684 test regexp-3.3 {-indices option to regexp} {
3687 list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2
3690 test regexp-3.4 {-indices option to regexp} {
3694 list [regexp -indices a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
3695 } {1 {0 5} {1 4} {5 5}}
3697 test regexp-3.5 {-indices option to regexp} {
3698 set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
3699 set f6 {}; set f7 {}; set f8 {}; set f9 {}
3700 list [regexp -indices (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) \
3702 foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \
3704 } {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}}
3706 test regexp-3.6 {getting substrings back from regexp} {
3707 set foo 2; set f2 2; set f3 2; set f4 2
3708 list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
3709 } {1 {1 1} {1 1} {-1 -1} {-1 -1}}
3711 test regexp-3.7 {getting substrings back from regexp} {
3712 set foo 1; set f2 1; set f3 1; set f4 1
3713 list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
3714 } {1 {1 2} {1 1} {-1 -1} {2 2}}
3716 test regexp-4.1 {-nocase option to regexp} {
3717 regexp -nocase foo abcFOo
3720 test regexp-4.2 {-nocase option to regexp} {
3724 list [regexp -nocase {a(b*)([xy]*)z} aBbbxYXxxZ22 f1 f2 f3] $f1 $f2 $f3
3725 } {1 aBbbxYXxxZ Bbb xYXxx}
3727 test regexp-4.3 {-nocase option to regexp} {
3728 regexp -nocase FOo abcFOo
3731 test regexp-4.4 {case conversion in regexp} {
3732 set x abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890
3733 list [regexp -nocase $x $x foo] $foo
3734 } {1 abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890}
3736 test regexp-5.1 {exercise cache of compiled expressions} {
3745 test regexp-5.2 {exercise cache of compiled expressions} {
3754 test regexp-5.3 {exercise cache of compiled expressions} {
3763 test regexp-5.4 {exercise cache of compiled expressions} {
3772 test regexp-5.5 {exercise cache of compiled expressions} {
3781 test regexp-6.1 {regexp errors} {
3782 list [catch {regexp a} msg] $msg
3783 } {1 {wrong # args: should be "regexp ?
-nocase? ?
-line? ?
-indices? ?
-start offset? ?
-all? ?
-inline? ?
--? exp
string ?matchVar? ?subMatchVar ...?
"}}
3785 test regexp-6.2 {regexp errors} {
3786 list [catch {regexp -nocase a} msg] $msg
3787 } {1 {wrong # args: should be "regexp ?
-nocase? ?
-line? ?
-indices? ?
-start offset? ?
-all? ?
-inline? ?
--? exp
string ?matchVar? ?subMatchVar ...?
"}}
3789 test regexp-6.3 {regexp errors} {
3790 list [catch {regexp -gorp a} msg] $msg
3791 } {1 {wrong # args: should be "regexp ?
-nocase? ?
-line? ?
-indices? ?
-start offset? ?
-all? ?
-inline? ?
--? exp
string ?matchVar? ?subMatchVar ...?
"}}
3793 test regexp-6.4 {regexp errors} {
3794 list [catch {regexp a( b} msg] $msg
3795 } {1 {couldn't compile regular expression pattern: parentheses not balanced}}
3797 test regexp-6.5 {regexp errors} {
3798 list [catch {regexp a( b} msg] $msg
3799 } {1 {couldn't compile regular expression pattern: parentheses not balanced}}
3801 test regexp-6.6 {regexp errors} {
3802 list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg
3805 test regexp-6.7 {regexp errors} {
3806 list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
3809 test regexp-6.8 {regexp errors} {
3812 list [catch {regexp abc abc f1(f2)} msg] $msg
3813 } {1 {can't set "f1
(f2
)": variable isn't array}}
3815 test regexp-6.9 {regexp errors, -start bad int check} {
3816 list [catch {regexp -start bogus {^$} {}} msg] $msg
3817 } {1 {expected integer but got "bogus
"}}
3819 test regexp-7.1 {basic regsub operation} {
3820 list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
3821 } {1 xax111aaa222xaa}
3823 test regexp-7.2 {basic regsub operation} {
3824 list [regsub aa+ aaaxaa &111 foo] $foo
3827 test regexp-7.3 {basic regsub operation} {
3828 list [regsub aa+ xaxaaa 111& foo] $foo
3831 test regexp-7.4 {basic regsub operation} {
3832 list [regsub aa+ aaa 11&2&333 foo] $foo
3835 test regexp-7.5 {basic regsub operation} {
3836 list [regsub aa+ xaxaaaxaa &2&333 foo] $foo
3837 } {1 xaxaaa2aaa333xaa}
3839 test regexp-7.6 {basic regsub operation} {
3840 list [regsub aa+ xaxaaaxaa 1&22& foo] $foo
3841 } {1 xax1aaa22aaaxaa}
3843 test regexp-7.7 {basic regsub operation} {
3844 list [regsub a(a+) xaxaaaxaa {1\122\1} foo] $foo
3847 test regexp-7.8 {basic regsub operation} {
3848 list [regsub a(a+) xaxaaaxaa {1\\\122\1} foo] $foo
3849 } {1 {xax1\aa22aaxaa}}
3851 test regexp-7.9 {basic regsub operation} {
3852 list [regsub a(a+) xaxaaaxaa {1\\122\1} foo] $foo
3853 } {1 {xax1\122aaxaa}}
3855 test regexp-7.10 {basic regsub operation} {
3856 list [regsub a(a+) xaxaaaxaa {1\\&\1} foo] $foo
3857 } {1 {xax1\aaaaaxaa}}
3859 test regexp-7.11 {basic regsub operation} {
3860 list [regsub a(a+) xaxaaaxaa {1\&\1} foo] $foo
3863 test regexp-7.12 {basic regsub operation} {
3864 list [regsub a(a+) xaxaaaxaa {\1\1\1\1&&} foo] $foo
3865 } {1 xaxaaaaaaaaaaaaaaxaa}
3867 test regexp-7.13 {basic regsub operation} {
3869 list [regsub abc xyz 111 foo] $foo
3872 test regexp-7.14 {basic regsub operation} {
3874 list [regsub ^ xyz "111 " foo] $foo
3877 test regexp-7.15 {basic regsub operation} {
3879 list [regsub -- -foo abc-foodef "111 " foo] $foo
3882 test regexp-7.16 {basic regsub operation} {
3884 list [regsub x "" y foo] $foo
3887 test regexp-8.1 {case conversion in regsub} {
3888 list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
3891 test regexp-8.2 {case conversion in regsub} {
3892 list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
3895 test regexp-8.3 {case conversion in regsub} {
3897 list [regsub a(a+) xaAAaAAay & foo] $foo
3900 test regexp-8.4 {case conversion in regsub} {
3902 list [regsub -nocase a CaDE b foo] $foo
3905 test regexp-8.5 {case conversion in regsub} {
3907 list [regsub -nocase XYZ CxYzD b foo] $foo
3910 test regexp-8.6 {case conversion in regsub} {
3911 set x abcdefghijklmnopqrstuvwxyz1234567890
3912 set x $x$x$x$x$x$x$x$x$x$x$x$x
3914 list [regsub -nocase $x $x b foo] $foo
3917 test regexp-9.1 {-all option to regsub} {
3919 list [regsub -all x+ axxxbxxcxdx |&| foo] $foo
3920 } {4 a|xxx|b|xx|c|x|d|x|}
3922 test regexp-9.2 {-all option to regsub} {
3924 list [regsub -nocase -all x+ aXxXbxxcXdx |&| foo] $foo
3925 } {4 a|XxX|b|xx|c|X|d|x|}
3927 test regexp-9.3 {-all option to regsub} {
3929 list [regsub x+ axxxbxxcxdx |&| foo] $foo
3932 test regexp-9.4 {-all option to regsub} {
3934 list [regsub -all bc axxxbxxcxdx |&| foo] $foo
3937 test regexp-9.5 {-all option to regsub} {
3939 list [regsub -all node "node node more
" yy foo] $foo
3942 test regexp-9.6 {-all option to regsub} {
3944 list [regsub -all ^ xxx 123 foo] $foo
3947 test regexp-10.2 {newline sensitivity in regsub} {
3949 list [regsub -line {^a.*b$} "dabc
\naxyb
\n" 123 foo] $foo
3954 test regexp-10.3 {newline sensitivity in regsub} {
3956 list [regsub -line {^a.*b$} "dabc
\naxyb
\nxb
" 123 foo] $foo
3961 test regexp-11.1 {regsub errors} {
3962 list [catch {regsub a b} msg] $msg
3963 } {1 {wrong # args: should be "regsub ?
-nocase? ?
-all? ?
-line? ?
-start offset? ?
--? exp
string subSpec ?varName?
"}}
3965 test regexp-11.2 {regsub errors} {
3966 list [catch {regsub -nocase a b} msg] $msg
3967 } {1 {wrong # args: should be "regsub ?
-nocase? ?
-all? ?
-line? ?
-start offset? ?
--? exp
string subSpec ?varName?
"}}
3969 test regexp-11.3 {regsub errors} {
3970 list [catch {regsub -nocase -all a b} msg] $msg
3971 } {1 {wrong # args: should be "regsub ?
-nocase? ?
-all? ?
-line? ?
-start offset? ?
--? exp
string subSpec ?varName?
"}}
3973 test regexp-11.4 {regsub errors} {
3974 list [catch {regsub a b c d e f} msg] $msg
3975 } {1 {wrong # args: should be "regsub ?
-nocase? ?
-all? ?
-line? ?
-start offset? ?
--? exp
string subSpec ?varName?
"}}
3977 test regexp-11.5 {regsub errors} {
3978 list [catch {regsub -gorp a b c} msg] $msg
3979 } {1 {wrong # args: should be "regsub ?
-nocase? ?
-all? ?
-line? ?
-start offset? ?
--? exp
string subSpec ?varName?
"}}
3981 test regexp-11.6 {regsub errors} {
3982 list [catch {regsub -nocase a( b c d} msg] $msg
3983 } {1 {couldn't compile regular expression pattern: parentheses not balanced}}
3985 test regexp-11.7 {regsub errors} {
3988 list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
3989 } {1 {can't set "f1
(f2
)": variable isn't array}}
3991 test regexp-11.8 {regsub errors, -start bad int check} {
3992 list [catch {regsub -start bogus pattern string rep var} msg] $msg
3993 } {1 {expected integer but got "bogus
"}}
3995 test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {
3996 list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z
3997 } {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}
3999 test regexp-13.1 {regsub of a very large string} {
4000 # This test is designed to stress the memory subsystem in order
4001 # to catch Bug #933. It only fails if the Tcl memory allocator
4004 set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE}
4005 set filedata [string repeat $line 200]
4006 for {set i 1} {$i<10} {incr i} {
4007 regsub -all "BEGIN_TABLE
" $filedata "" newfiledata
4012 test regexp-14.1 {CompileRegexp: regexp cache} {
4023 test regexp-14.2 {CompileRegexp: regexp cache, different flags} {
4031 regexp -nocase $x bbba
4034 test regexp-15.1 {regexp -start} {
4036 list [regexp -start -10 {[0-9]} 1abc2de3 x] $x
4039 test regexp-15.2 {regexp -start} {
4041 list [regexp -start 2 {[0-9]} 1abc2de3 x] $x
4044 test regexp-15.3 {regexp -start} {
4046 list [regexp -start 4 {[0-9]} 1abc2de3 x] $x
4049 test regexp-15.4 {regexp -start} {
4051 list [regexp -start 5 {[0-9]} 1abc2de3 x] $x
4054 test regexp-15.5 {regexp -start, over end of string} {
4056 list [regexp -start [string length 1abc2de3] {[0-9]} 1abc2de3 x] [info exists x]
4059 test regexp-15.6 {regexp -start, loss of ^$ behavior} {
4060 list [regexp -start 2 {^$} {}]
4063 test regexp-16.1 {regsub -start} {
4065 list [regsub -all -start 2 {[0-9]} a1b2c3d4e5 {/&} x] $x
4066 } {4 a1b/2c/3d/4e/5}
4068 test regexp-16.2 {regsub -start} {
4070 list [regsub -all -start -25 {z} hello {/&} x] $x
4073 test regexp-16.3 {regsub -start} {
4075 list [regsub -all -start 3 {z} hello {/&} x] $x
4078 test regexp-17.1 {regexp -inline} {
4079 regexp -inline b ababa
4082 test regexp-17.2 {regexp -inline} {
4083 regexp -inline (b) ababa
4086 test regexp-17.3 {regexp -inline -indices} {
4087 regexp -inline -indices (b) ababa
4090 test regexp-17.4 {regexp -inline} {
4091 regexp -inline {[[:alnum:]_]([0-9]+)[[:alnum:]_]} " hello
23 there456def
"
4094 test regexp-17.5 {regexp -inline no matches} {
4095 regexp -inline {[[:alnum:]_]([0-9]+)[[:alnum:]_]} ""
4098 test regexp-17.6 {regexp -inline no matches} {
4099 regexp -inline hello goodbye
4102 test regexp-17.7 {regexp -inline, no matchvars allowed} {
4103 list [catch {regexp -inline b abc match} msg] $msg
4104 } {1 {regexp match variables not allowed when using -inline}}
4106 test regexp-18.1 {regexp -all} {
4110 test regexp-18.2 {regexp -all} {
4111 regexp -all b abababbabaaaaaaaaaab
4114 test regexp-18.3 {regexp -all -inline} {
4115 regexp -all -inline b abababbabaaaaaaaaaab
4118 test regexp-18.4 {regexp -all -inline} {
4119 regexp -all -inline {[[:alnum:]_]([[:alnum:]_])} abcdefg
4122 test regexp-18.5 {regexp -all -inline} {
4123 regexp -all -inline {[[:alnum:]_]([[:alnum:]_])$} abcdefg
4126 test regexp-18.6 {regexp -all -inline} {
4127 regexp -all -inline {[0-9]+} 10:20:30:40
4130 test regexp-18.7 {regexp -all -inline} {
4131 list [catch {regexp -all -inline b abc match} msg] $msg
4132 } {1 {regexp match variables not allowed when using -inline}}
4134 test regexp-18.8 {regexp -all} {
4135 # This should not cause an infinite loop
4136 regexp -all -inline {a*} a
4139 test regexp-18.9 {regexp -all} {
4140 # Yes, the expected result is {a {}}. Here's why:
4141 # Start at index 0; a* matches the "a
" there then stops.
4142 # Go to index 1; a* matches the lambda (or {}) there then stops. Recall
4143 # that a* matches zero or more "a
"'s; thus it matches the string "b
", as
4144 # there are zero or more "a
"'s there.
4145 # Go to index 2; this is past the end of the string, so stop.
4146 regexp -all -inline {a*} ab
4149 test regexp-18.10 {regexp -all} {
4150 # Yes, the expected result is {a {} a}. Here's why:
4151 # Start at index 0; a* matches the "a
" there then stops.
4152 # Go to index 1; a* matches the lambda (or {}) there then stops. Recall
4153 # that a* matches zero or more "a
"'s; thus it matches the string "b
", as
4154 # there are zero or more "a
"'s there.
4155 # Go to index 2; a* matches the "a
" there then stops.
4156 # Go to index 3; this is past the end of the string, so stop.
4157 regexp -all -inline {a*} aba
4160 test regexp-18.11 {regexp -all} {
4161 regexp -all -inline {^a} aaaa
4164 test regexp-19.1 {regsub null replacement} {
4165 regsub -all {@} {@hel@lo@} "\0a
\0" result
4166 list $result [string length $result]
4170 ################################################################################
4172 ################################################################################
4174 test range-1.1 {basic range tests} {
4176 } {0 1 2 3 4 5 6 7 8 9}
4178 test range-1.2 {basic range tests} {
4180 } {10 9 8 7 6 5 4 3 2 1}
4182 test range-1.3 {basic range tests} {
4186 test range-1.4 {basic range tests} {
4190 test range-1.5 {basic range tests} {
4194 test range-1.6 {basic range tests} {
4198 test range-1.7 {basic range test} {
4202 test range-1.8 {basic range test} {
4204 } {-10 -12 -14 -16 -18}
4206 test range-1.9 {basic range test} {
4210 test range-2.0 {foreach range test} {
4212 foreach {x y} [range 100] {
4213 incr k [expr {$x*$y}]
4218 test range-2.1 {foreach range test without obj reuse} {
4221 foreach {x y} [range 100] {
4222 incr k [expr {$x*$y}]
4229 test range-2.2 {range element shimmering test} {
4231 foreach x [range 0 10] {
4232 append k [llength $x]
4237 test range-3.0 {llength range test} {
4238 llength [range 5000]
4241 test range-3.1 {llength range test} {
4242 llength [range 5000 5000]
4245 test range-4.0 {lindex range test} {
4246 lindex [range 1000] 500
4249 test range-4.1 {lindex range test} {
4250 lindex [range 1000] end-2
4253 test range-5.0 {lindex llength range test} {
4257 for {set i 0} {$i < [llength $r]} {incr i 2} {
4258 incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}]
4264 ################################################################################
4266 ################################################################################
4268 test scope-1.0 {Non existing var} {
4274 list [info exists x] $y
4277 test scope-1.1 {Existing var restore} {
4280 for {set x 0} {$x < 10} {incr x} {}
4285 test scope-1.2 {Mix of 1.0 and 1.1 tests} {
4292 list [info exists x] $y
4295 test scope-1.3 {Array element} {
4303 test scope-1.4 {Non existing array element} {
4311 test scope-1.5 {Info exists} {
4322 ################################################################################
4324 ################################################################################
4325 test rand-1.0 {Only one output is valid} {
4326 list [rand 100 100] [rand 101 101]
4329 test rand-1.1 {invalid arguments} {
4330 catch {rand 100 50} err
4332 } {Invalid arguments (max < min)}
4334 test rand-1.2 {Check limits} {
4336 for {set i 0} {$i < 100} {incr i} {
4337 incr sum [expr {([rand $i] >= 0)+([rand $i] < 100)}]
4342 catch {unset sum; unset err; unset i}
4344 ################################################################################
4345 # JIM REGRESSION TESTS
4346 ################################################################################
4347 test regression-1.0 {Rename against procedures with static vars} {
4348 proc foobar {x} {{y 10}} {
4353 rename foobar barfoo
4354 list [barfoo 1] [barfoo 2] [barfoo 3]
4359 test regression-1.1 {lrange bug with negative indexes of type int} {
4360 lrange {a b c} 0 [- 0 1]
4363 ################################################################################
4365 ################################################################################
4367 puts "----------------------------------------------------------------------"
4368 puts "FAILED
: $failedTests"
4369 foreach testId $failedList {
4372 puts "PASSED
: $passedTests"
4373 puts "----------------------------------------------------------------------\n"