Update test.tcl for new regsub/regexp error message
[jimtcl.git] / test.tcl
blob07ff0c896cf5c9a8a848e78e322b6401442a8a70
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
6 # and so on).
8 # Sometimes tests are modified to reflect different error messages.
10 set failedTests 0
11 set failedList {}
12 set passedTests 0
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} {
20 puts "OK"
21 incr passedTests
22 } else {
23 puts "ERR"
24 puts "Expected: '$expectedResult'"
25 puts "Got : '$result'"
26 incr failedTests
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 ################################################################################
38 # SET
39 ################################################################################
41 test set-1.2 {TclCompileSetCmd: simple variable name} {
42 set i 10
43 list [set i] $i
44 } {10 10}
46 test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
47 set i 17
48 list [set "i"] $i
49 } {17 17}
51 test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} {
52 set x "i"
53 set i 77
54 list [set $x] $i
55 } {77 77}
57 test set-1.8 {TclCompileSetCmd: non-simple (computed) variable name} {
58 set x "i"
59 set i 77
60 list [set [set x] 2] $i
61 } {2 2}
63 test set-1.9 {TclCompileSetCmd: 3rd arg => assignment} {
64 set i "abcdef"
65 list [set i] $i
66 } {abcdef abcdef}
68 test set-1.10 {TclCompileSetCmd: only two args => just getting value} {
69 set i {one two}
70 set i
71 } {one two}
73 test set-1.11 {TclCompileSetCmd: simple global name} {
74 proc p {} {
75 global i
76 set i 54
77 set i
80 } {54}
82 test set-1.12 {TclCompileSetCmd: simple local name} {
83 proc p {bar} {
84 set foo $bar
85 set foo
87 p 999
88 } {999}
90 test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} {
91 proc 260locals {} {
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
146 260locals
147 } {1234}
149 test set-1.17 {TclCompileSetCmd: doing assignment, simple int} {
150 set i 5
151 set i 123
152 } 123
154 test set-1.18 {TclCompileSetCmd: doing assignment, simple int} {
155 set i 5
156 set i -100
157 } -100
159 test set-1.19 {TclCompileSetCmd: doing assignment, simple but not int} {
160 set i 5
161 set i 0x12MNOP
162 set i
163 } {0x12MNOP}
165 test set-1.20 {TclCompileSetCmd: doing assignment, in quotes} {
166 set i 25
167 set i "-100"
168 } -100
170 test set-1.21 {TclCompileSetCmd: doing assignment, in braces} {
171 set i 24
172 set i {126}
173 } 126
175 test set-1.22 {TclCompileSetCmd: doing assignment, large int} {
176 set i 5
177 set i 200000
178 } 200000
180 test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} {
181 set i 25
182 set i 000012345 ;# an octal literal == 5349 decimal
183 list $i [incr i]
184 } {000012345 5350}
186 ################################################################################
187 # LIST
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} {}
215 set num 0
216 proc lcheck {testid a b c} {
217 global num d
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
238 concat {}
240 ################################################################################
241 # WHILE
242 ################################################################################
244 test while-1.9 {TclCompileWhileCmd: simple command body} {
245 set a {}
246 set i 1
247 while {$i<6} {
248 if $i==4 break
249 set a [concat $a $i]
250 incr i
252 set a
253 } {1 2 3}
255 test while-1.10 {TclCompileWhileCmd: command body in quotes} {
256 set a {}
257 set i 1
258 while {$i<6} "append a x; incr i"
259 set a
260 } {xxxxx}
262 test while-1.13 {TclCompileWhileCmd: while command result} {
263 set i 0
264 set a [while {$i < 5} {incr i}]
265 set a
266 } {}
268 test while-1.14 {TclCompileWhileCmd: while command result} {
269 set i 0
270 set a [while {$i < 5} {if $i==3 break; incr i}]
271 set a
272 } {}
274 test while-2.1 {continue tests} {
275 set a {}
276 set i 1
277 while {$i <= 4} {
278 incr i
279 if {$i == 3} continue
280 set a [concat $a $i]
282 set a
283 } {2 4 5}
284 test while-2.2 {continue tests} {
285 set a {}
286 set i 1
287 while {$i <= 4} {
288 incr i
289 if {$i != 2} continue
290 set a [concat $a $i]
292 set a
293 } {2}
294 test while-2.3 {continue tests, nested loops} {
295 set msg {}
296 set i 1
297 while {$i <= 4} {
298 incr i
299 set a 1
300 while {$a <= 2} {
301 incr a
302 if {$i>=3 && $a>=3} continue
303 set msg [concat $msg "$i.$a"]
306 set msg
307 } {2.2 2.3 3.2 4.2 5.2}
309 test while-4.1 {while and computed command names} {
310 set i 0
311 set z while
312 $z {$i < 10} {
313 incr i
315 set i
316 } 10
318 test while-5.2 {break tests with computed command names} {
319 set a {}
320 set i 1
321 set z break
322 while {$i <= 4} {
323 if {$i == 3} $z
324 set a [concat $a $i]
325 incr i
327 set a
328 } {1 2}
330 test while-7.1 {delayed substitution of body} {
331 set i 0
332 while {[incr i] < 10} "
333 set result $i
335 proc p {} {
336 set i 0
337 while {[incr i] < 10} "
338 set result $i
340 set result
342 append result [p]
343 } {00}
345 ################################################################################
346 # LSET
347 ################################################################################
349 set lset lset
351 test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} {
352 set x {0 1 2}
353 list [eval [list $lset x 0 3]] $x
354 } {{3 1 2} {3 1 2}}
356 test lset-3.1 {lset, not compiled, 3 args, data duplicated} {
357 set x {0 1 2}
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} {
362 set x {0 1}
363 set y $x
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} {
368 set x {0 1}
369 set y $x
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} {
374 set x {0 1 2}
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} {
379 set x {0 1}
380 set y $x
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} {
385 set x {0 1}
386 set y $x
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} {
391 set a {x y z}
392 list [catch {
393 eval [list $lset a [list 2a2] w]
394 } msg] $msg
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} {
398 set a {x y z}
399 list [catch {
400 eval [list $lset a [list -1] w]
401 } msg] $msg
402 } {1 {list index out of range}}
404 test lset-4.4 {lset, not compiled, 3 args, index out of range} {
405 set a {x y z}
406 list [catch {
407 eval [list $lset a [list 3] w]
408 } msg] $msg
409 } {1 {list index out of range}}
411 test lset-4.5 {lset, not compiled, 3 args, index out of range} {
412 set a {x y z}
413 list [catch {
414 eval [list $lset a [list end--1] w]
415 } msg] $msg
416 } {1 {list index out of range}}
418 test lset-4.6 {lset, not compiled, 3 args, index out of range} {
419 set a {x y z}
420 list [catch {
421 eval [list $lset a [list end-3] w]
422 } msg] $msg
423 } {1 {list index out of range}}
425 test lset-4.8 {lset, not compiled, 3 args, bad index} {
426 set a {x y z}
427 list [catch {
428 eval [list $lset a 2a2 w]
429 } msg] $msg
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} {
433 set a {x y z}
434 list [catch {
435 eval [list $lset a -1 w]
436 } msg] $msg
437 } {1 {list index out of range}}
439 test lset-4.10 {lset, not compiled, 3 args, index out of range} {
440 set a {x y z}
441 list [catch {
442 eval [list $lset a 3 w]
443 } msg] $msg
444 } {1 {list index out of range}}
446 test lset-4.11 {lset, not compiled, 3 args, index out of range} {
447 set a {x y z}
448 list [catch {
449 eval [list $lset a end--1 w]
450 } msg] $msg
451 } {1 {list index out of range}}
453 test lset-4.12 {lset, not compiled, 3 args, index out of range} {
454 set a {x y z}
455 list [catch {
456 eval [list $lset a end-3 w]
457 } msg] $msg
458 } {1 {list index out of range}}
460 test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} {
461 set a {x y z}
462 list [eval [list $lset a 0 a]] $a
463 } {{a y z} {a y z}}
465 test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} {
466 set a {x y z}
467 list [eval [list $lset a [list 0] a]] $a
468 } {{a y z} {a y z}}
470 test lset-6.3 {lset, not compiled, 1-d list basics} {
471 set a {x y z}
472 list [eval [list $lset a 2 a]] $a
473 } {{x y a} {x y a}}
475 test lset-6.4 {lset, not compiled, 1-d list basics} {
476 set a {x y z}
477 list [eval [list $lset a [list 2] a]] $a
478 } {{x y a} {x y a}}
480 test lset-6.5 {lset, not compiled, 1-d list basics} {
481 set a {x y z}
482 list [eval [list $lset a end a]] $a
483 } {{x y a} {x y a}}
485 test lset-6.6 {lset, not compiled, 1-d list basics} {
486 set a {x y z}
487 list [eval [list $lset a [list end] a]] $a
488 } {{x y a} {x y a}}
490 test lset-6.7 {lset, not compiled, 1-d list basics} {
491 set a {x y z}
492 list [eval [list $lset a end-0 a]] $a
493 } {{x y a} {x y a}}
495 test lset-6.8 {lset, not compiled, 1-d list basics} {
496 set a {x y z}
497 list [eval [list $lset a [list end-0] a]] $a
498 } {{x y a} {x y a}}
499 test lset-6.9 {lset, not compiled, 1-d list basics} {
500 set a {x y z}
501 list [eval [list $lset a end-2 a]] $a
502 } {{a y z} {a y z}}
504 test lset-6.10 {lset, not compiled, 1-d list basics} {
505 set a {x y z}
506 list [eval [list $lset a [list end-2] a]] $a
507 } {{a y z} {a y z}}
509 test lset-7.1 {lset, not compiled, data sharing} {
510 set a 0
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} {
515 set a [list 0]
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} {
520 set a {x y}
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} {
525 set a {x y}
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} {
530 set n 0
531 set a {x y}
532 list [eval [list $lset a $n $n]] $a $n
533 } {{0 y} {0 y} 0}
535 test lset-7.6 {lset, not compiled, data sharing} {
536 set n [list 0]
537 set a {x y}
538 list [eval [list $lset a $n $n]] $a $n
539 } {{0 y} {0 y} 0}
541 test lset-7.7 {lset, not compiled, data sharing} {
542 set n 0
543 set a [list $n $n]
544 list [eval [list $lset a $n 1]] $a $n
545 } {{1 0} {1 0} 0}
547 test lset-7.8 {lset, not compiled, data sharing} {
548 set n [list 0]
549 set a [list $n $n]
550 list [eval [list $lset a $n 1]] $a $n
551 } {{1 0} {1 0} 0}
553 test lset-7.9 {lset, not compiled, data sharing} {
554 set a 0
555 list [eval [list $lset a $a $a]] $a
556 } {0 0}
558 test lset-7.10 {lset, not compiled, data sharing} {
559 set a [list 0]
560 list [eval [list $lset a $a $a]] $a
561 } {0 0}
563 test lset-8.3 {lset, not compiled, bad second index} {
564 set a {{b c} {d e}}
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} {
589 set a x
590 list [eval [list $lset a y]] $a
591 } {y y}
593 test lset-10.1 {lset, not compiled, shared data} {
594 set row {p q}
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} {
600 set a {{b c} {d e}}
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} {
605 set a {{b c} {d e}}
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} {
610 set a {{b c} {d e}}
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} {
615 set a {{b c} {d e}}
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} {
620 set zero 0
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]
626 set ident
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} {
630 set a 0
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} {
635 set a [list 0]
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 }"
645 catch {unset noRead}
646 catch {unset noWrite}
647 catch {rename failTrace {}}
648 catch {unset ::x}
649 catch {unset ::y}
651 ################################################################################
652 # IF
653 ################################################################################
655 test if-1.1 {bad syntax: lacking all} {
656 catch {if}
658 test if-1.2 {bad syntax: lacking then-clause} {
659 catch {if 1==1}
661 test if-1.3 {bad syntax: lacking then-clause 2} {
662 catch {if 1==1 then}
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} {
683 set a {}
684 if 0 {set a 1} else {set a 2}
685 set a
687 test if-2.2 {taking proper branch} {
688 set a {}
689 if 1 {set a 1} else {set a 2}
690 set a
692 test if-2.3 {taking proper branch} {
693 set a {}
694 if 1<2 {set a 1}
695 set a
697 test if-2.4 {taking proper branch} {
698 set a {}
699 if 1>2 {set a 1}
700 set a
701 } {}
702 test if-2.5 {taking proper branch} {
703 set a {}
704 if 0 {set a 1} else {}
705 set a
706 } {}
707 test if-2.6 {taking proper branch} {
708 set a {}
709 if 0 {set a 1} elseif 1 {set a 2} elseif 1 {set a 3} else {set a 4}
710 set a
712 test if-2.7 {taking proper branch} {
713 set a {}
714 if 0 {set a 1} elseif 0 {set a 2} elseif 1 {set a 3} else {set a 4}
715 set a
717 test if-2.8 {taking proper branch} {
718 set a {}
719 if 0 {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} else {set a 4}
720 set a
722 test if-2.9 {taking proper branch, multiline test expr} {
723 set a {}
724 if {1 != \
725 3} {set a 3} else {set a 4}
726 set a
728 test if-3.1 {optional then-else args} {
729 set a 44
730 if 0 then {set a 1} elseif 0 then {set a 3} else {set a 2}
731 set a
733 test if-3.2 {optional then-else args} {
734 set a 44
735 if 1 then {set a 1} else {set a 2}
736 set a
738 test if-3.3 {optional then-else args} {
739 set a 44
740 if 0 {set a 1} else {set a 2}
741 set a
743 test if-3.4 {optional then-else args} {
744 set a 44
745 if 1 {set a 1} else {set a 2}
746 set a
748 test if-3.5 {optional then-else args} {
749 set a 44
750 if 0 then {set a 1} {set a 2}
751 set a
753 test if-3.6 {optional then-else args} {
754 set a 44
755 if 1 then {set a 1} {set a 2}
756 set a
758 test if-3.7 {optional then-else args} {
759 set a 44
760 if 0 then {set a 1} else {set a 2}
761 set a
763 test if-3.8 {optional then-else args} {
764 set a 44
765 if 0 then {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} {set a 4}
766 set a
768 test if-4.1 {return value} {
769 if 1 then {set a 22; concat abc}
770 } abc
771 test if-4.2 {return value} {
772 if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
773 } def
774 test if-4.3 {return value} {
775 if 0 then {set a 22; concat abc} else {concat def}
776 } def
777 test if-4.4 {return value} {
778 if 0 then {set a 22; concat abc}
779 } {}
780 test if-4.5 {return value} {
781 if 0 then {set a 22; concat abc} elseif 0 {concat def}
782 } {}
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 ################################################################################
803 # APPEND
804 ################################################################################
806 catch {unset x}
808 test append-1.1 {append command} {
809 catch {unset x}
810 list [append x 1 2 abc "long string"] $x
811 } {{12abclong string} {12abclong string}}
812 test append-1.2 {append command} {
813 set x ""
814 list [append x first] [append x second] [append x third] $x
815 } {first firstsecond firstsecondthird firstsecondthird}
816 test append-1.3 {append command} {
817 set x "abcd"
818 append x
819 } abcd
821 test append-2.1 {long appends} {
822 set x ""
823 for {set i 0} {$i < 1000} {set i [expr $i+1]} {
824 append x "foobar "
826 set y "foobar"
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 "
830 expr {$x eq $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} {
837 set x 1
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} {
841 catch {unset x}
842 list [catch {append x} msg] $msg
843 } {1 {can't read "x": no such variable}}
845 test append-4.1 {lappend command} {
846 catch {unset x}
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} {
850 set x ""
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} {
854 proc foo {} {
855 global x
856 set x old
857 unset x
858 lappend x new
860 set result [foo]
861 rename foo {}
862 set result
863 } {new}
864 test append-4.4 {lappend command} {
865 set x {}
866 lappend x \{\ abc
867 } {\{\ abc}
868 test append-4.5 {lappend command} {
869 set x {}
870 lappend x \{ abc
871 } {\{ abc}
872 test append-4.6 {lappend command} {
873 set x {1 2 3}
874 lappend x
875 } {1 2 3}
876 test append-4.7 {lappend command} {
877 set x "a\{"
878 lappend x abc
879 } "a\\\{ abc"
880 test append-4.8 {lappend command} {
881 set x "\\\{"
882 lappend x abc
883 } "\\{ abc"
884 #test append-4.9 {lappend command} {
885 # set x " \{"
886 # list [catch {lappend x abc} msg] $msg
887 #} {1 {unmatched open brace in list}}
888 #test append-4.10 {lappend command} {
889 # set x " \{"
890 # list [catch {lappend x abc} msg] $msg
891 #} {1 {unmatched open brace in list}}
892 #test append-4.11 {lappend command} {
893 # set x "\{\{\{"
894 # list [catch {lappend x abc} msg] $msg
895 #} {1 {unmatched open brace in list}}
896 #test append-4.12 {lappend command} {
897 # set x "x \{\{\{"
898 # list [catch {lappend x abc} msg] $msg
899 #} {1 {unmatched open brace in list}}
900 test append-4.13 {lappend command} {
901 set x "x\{\{\{"
902 lappend x abc
903 } "x\\\{\\\{\\\{ abc"
904 test append-4.14 {lappend command} {
905 set x " "
906 lappend x abc
907 } "abc"
908 test append-4.15 {lappend command} {
909 set x "\\ "
910 lappend x abc
911 } "{ } abc"
912 test append-4.16 {lappend command} {
913 set x "x "
914 lappend x abc
915 } "x abc"
916 test append-4.17 {lappend command} {
917 catch {unset x}
918 lappend x
919 } {}
920 test append-4.18 {lappend command} {
921 catch {unset x}
922 lappend x {}
923 } {{}}
924 test append-4.19 {lappend command} {
925 catch {unset x}
926 lappend x(0)
927 } {}
928 test append-4.20 {lappend command} {
929 catch {unset x}
930 lappend x(0) abc
931 } {abc}
933 proc check {var size} {
934 set l [llength $var]
935 if {$l != $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\""
944 return ok
946 test append-5.1 {long lappends} {
947 catch {unset x}
948 set x ""
949 for {set i 0} {$i < 300} {set i [expr $i+1]} {
950 lappend x "item $i"
952 check $x 300
953 } ok
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} {
959 set x 1
960 list [catch {lappend x(0) 44} msg] $msg
961 } {1 {can't set "x(0)": variable isn't array}}
963 ################################################################################
964 # UPLEVEL
965 ################################################################################
967 proc a {x y} {
968 newset z [expr $x+$y]
969 return $z
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} {
977 set xyz 0
978 a 22 33
979 } 55
980 test uplevel-1.2 {command is another uplevel command} {
981 set xyz 0
982 a 22 33
983 set xyz
984 } 22
986 proc a1 {} {
988 global a a1
989 set a $x
990 set a1 $y
992 proc b1 {} {
994 global b b1
995 set b $x
996 set b1 $y
998 proc c1 {} {
999 uplevel 1 set x 111
1000 uplevel #2 set y 222
1001 uplevel 2 set x 333
1002 uplevel #1 set y 444
1003 uplevel 3 set x 555
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} {
1015 set x 33
1016 uplevel #0 set x 44
1017 set x
1018 } 44
1019 test uplevel-3.2 {uplevel to same level} {
1020 set x 33
1021 uplevel 0 set x
1022 } 33
1023 test uplevel-3.3 {uplevel to same level} {
1024 set y xxx
1025 proc a1 {} {set y 55; uplevel 0 set y 66; return $y}
1027 } 66
1028 test uplevel-3.4 {uplevel to same level} {
1029 set y zzz
1030 proc a1 {} {set y 55; uplevel #1 set y}
1032 } 55
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 ...?"}}
1049 proc a2 {} {
1050 uplevel a3
1052 proc a3 {} {
1053 global x y
1054 set x [info level]
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 ################################################################################
1062 # UNKNOWN
1063 ################################################################################
1065 catch {unset x}
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} {
1073 global x
1074 set x $args
1077 test unknown-2.1 {calling "unknown" command} {
1078 foobar x y z
1079 set x
1080 } {foobar x y z}
1081 test unknown-2.2 {calling "unknown" command with lots of args} {
1082 foobar 1 2 3 4 5 6 7
1083 set x
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
1087 set x
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
1091 set x
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 \]
1096 set x
1097 } "foobar \\{ \\} a\\{b {;} \\\\ {\$a} {a\[b} \\]"
1099 proc unknown args {
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}}
1107 rename unknown {}
1109 ################################################################################
1110 # INCR
1111 ################################################################################
1113 catch {unset x}
1114 catch {unset i}
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} {
1120 set i 10
1121 list [incr i] $i
1122 } {11 11}
1123 #test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
1124 # set i 10
1125 # catch {incr "i"xxx} msg
1126 # set msg
1127 #} {extra characters after close-quote}
1128 test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
1129 set i 17
1130 list [incr "i"] $i
1131 } {18 18}
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}
1136 } {28 28}
1137 test incr-1.6 {TclCompileIncrCmd: simple array variable name} {
1138 catch {unset a}
1139 set a(foo) 37
1140 list [incr a(foo)] $a(foo)
1141 } {38 38}
1142 test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
1143 set x "i"
1144 set i 77
1145 list [incr $x 2] $i
1146 } {79 79}
1147 test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
1148 set x "i"
1149 set i 77
1150 list [incr [set x] +2] $i
1151 } {79 79}
1153 test incr-1.9 {TclCompileIncrCmd: increment given} {
1154 set i 10
1155 list [incr i +07] $i
1156 } {17 17}
1157 test incr-1.10 {TclCompileIncrCmd: no increment given} {
1158 set i 10
1159 list [incr i] $i
1160 } {11 11}
1162 test incr-1.11 {TclCompileIncrCmd: simple global name} {
1163 proc p {} {
1164 global i
1165 set i 54
1166 incr i
1169 } {55}
1170 test incr-1.12 {TclCompileIncrCmd: simple local name} {
1171 proc p {} {
1172 set foo 100
1173 incr foo
1176 } {101}
1177 test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} {
1178 proc p {} {
1179 incr bar
1181 catch {p} msg
1182 set msg
1183 } {1}
1184 test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
1185 proc 260locals {} {
1186 # create 260 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)
1240 incr z9
1242 260locals
1243 } {1}
1244 test incr-1.15 {TclCompileIncrCmd: variable is array} {
1245 catch {unset a}
1246 set a(foo) 27
1247 set x [incr a(foo) 11]
1248 catch {unset a}
1249 set x
1250 } 38
1251 test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} {
1252 catch {unset a}
1253 set i 5
1254 set a(foo5) 27
1255 set x [incr a(foo$i) 11]
1256 catch {unset a}
1257 set x
1258 } 38
1260 test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
1261 set i 5
1262 incr i 123
1263 } 128
1264 test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
1265 set i 5
1266 incr i -100
1267 } -95
1268 #test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} {
1269 # set i 5
1270 # catch {incr i [set]} msg
1271 # set errorInfo
1272 #} {wrong # args: should be "set varName ?newValue?"
1273 # while compiling
1274 #"set"
1275 # while compiling
1276 #"incr i [set]"}
1277 test incr-1.20 {TclCompileIncrCmd: increment given, in quotes} {
1278 set i 25
1279 incr i "-100"
1280 } -75
1281 test incr-1.21 {TclCompileIncrCmd: increment given, in braces} {
1282 set i 24
1283 incr i {126}
1284 } 150
1285 test incr-1.22 {TclCompileIncrCmd: increment given, large int} {
1286 set i 5
1287 incr i 200000
1288 } 200005
1289 test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
1290 set i 25
1291 incr i 000012345 ;# an octal literal
1292 } 5374
1293 test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
1294 set i 25
1295 catch {incr i 1a} msg
1296 set msg
1297 } {expected integer but got "1a"}
1299 test incr-1.25 {TclCompileIncrCmd: too many arguments} {
1300 set i 10
1301 catch {incr i 10 20} msg
1302 set msg
1303 } {wrong # args: should be "incr varName ?increment?"}
1306 test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
1307 set x " - "
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)} {
1312 catch {unset array}
1313 set array(\$foo) 4
1314 incr {array($foo)}
1317 # Check "incr" and computed command names.
1319 test incr-2.0 {incr and computed command names} {
1320 set i 5
1321 set z incr
1322 $z i -1
1323 set i
1325 catch {unset x}
1326 catch {unset i}
1328 test incr-2.1 {incr command (not compiled): missing variable name} {
1329 set z incr
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} {
1333 set z incr
1334 set i 10
1335 list [$z i] $i
1336 } {11 11}
1337 test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
1338 set z incr
1339 set i 17
1340 list [$z "i"] $i
1341 } {18 18}
1342 test incr-2.5 {incr command (not compiled): simple variable name in braces} {
1343 set z incr
1344 catch {unset {a simple var}}
1345 set {a simple var} 27
1346 list [$z {a simple var}] ${a simple var}
1347 } {28 28}
1348 test incr-2.6 {incr command (not compiled): simple array variable name} {
1349 set z incr
1350 catch {unset a}
1351 set a(foo) 37
1352 list [$z a(foo)] $a(foo)
1353 } {38 38}
1354 test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
1355 set z incr
1356 set x "i"
1357 set i 77
1358 list [$z $x 2] $i
1359 } {79 79}
1360 test incr-2.8 {incr command (not compiled): non-simple (computed) variable name} {
1361 set z incr
1362 set x "i"
1363 set i 77
1364 list [$z [set x] +2] $i
1365 } {79 79}
1367 test incr-2.9 {incr command (not compiled): increment given} {
1368 set z incr
1369 set i 10
1370 list [$z i +07] $i
1371 } {17 17}
1372 test incr-2.10 {incr command (not compiled): no increment given} {
1373 set z incr
1374 set i 10
1375 list [$z i] $i
1376 } {11 11}
1378 test incr-2.11 {incr command (not compiled): simple global name} {
1379 proc p {} {
1380 set z incr
1381 global i
1382 set i 54
1383 $z i
1386 } {55}
1387 test incr-2.12 {incr command (not compiled): simple local name} {
1388 proc p {} {
1389 set z incr
1390 set foo 100
1391 $z foo
1394 } {101}
1395 test incr-2.13 {incr command (not compiled): simple but new (unknown) local name} {
1396 proc p {} {
1397 set z incr
1398 $z bar
1400 catch {p} msg
1401 set msg
1402 } {1}
1403 test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
1404 proc 260locals {} {
1405 set z incr
1406 # create 260 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)
1460 $z z9
1462 260locals
1463 } {1}
1464 test incr-2.15 {incr command (not compiled): variable is array} {
1465 set z incr
1466 catch {unset a}
1467 set a(foo) 27
1468 set x [$z a(foo) 11]
1469 catch {unset a}
1470 set x
1471 } 38
1472 test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} {
1473 set z incr
1474 catch {unset a}
1475 set i 5
1476 set a(foo5) 27
1477 set x [$z a(foo$i) 11]
1478 catch {unset a}
1479 set x
1480 } 38
1482 test incr-2.17 {incr command (not compiled): increment given, simple int} {
1483 set z incr
1484 set i 5
1485 $z i 123
1486 } 128
1487 test incr-2.18 {incr command (not compiled): increment given, simple int} {
1488 set z incr
1489 set i 5
1490 $z i -100
1491 } -95
1492 test incr-2.20 {incr command (not compiled): increment given, in quotes} {
1493 set z incr
1494 set i 25
1495 $z i "-100"
1496 } -75
1497 test incr-2.21 {incr command (not compiled): increment given, in braces} {
1498 set z incr
1499 set i 24
1500 $z i {126}
1501 } 150
1502 test incr-2.22 {incr command (not compiled): increment given, large int} {
1503 set z incr
1504 set i 5
1505 $z i 200000
1506 } 200005
1507 test incr-2.23 {incr command (not compiled): increment given, formatted int != int} {
1508 set z incr
1509 set i 25
1510 $z i 000012345 ;# an octal literal
1511 } 5374
1512 test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
1513 set z incr
1514 set i 25
1515 catch {$z i 1a} msg
1516 set msg
1517 } {expected integer but got "1a"}
1519 test incr-2.25 {incr command (not compiled): too many arguments} {
1520 set z incr
1521 set i 10
1522 catch {$z i 10 20} msg
1523 set msg
1524 } {wrong # args: should be "incr varName ?increment?"}
1526 test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
1527 set z incr
1528 set x " - "
1529 list [catch {$z x 1} msg] $msg
1530 } {1 {expected integer but got " - "}}
1532 ################################################################################
1533 # LLENGTH
1534 ################################################################################
1536 test llength-1.1 {length of list} {
1537 llength {a b c d}
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} {
1543 llength {}
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 ################################################################################
1554 # LINDEX
1555 ################################################################################
1557 set lindex lindex
1558 set minus -
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} {
1569 # set x {}
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} {
1574 set x { 1 }
1575 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1576 } {b b}
1578 test lindex-2.4 {malformed index list} {
1579 set x \{
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} {
1586 set x ${minus}1
1587 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1588 } {{} {}}
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]]
1593 } {a a}
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]]
1598 } {c c}
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]]
1603 } {{} {}}
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} {
1613 set x end
1614 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1615 } {c c}
1617 test lindex-4.2 {index = end--1} {
1618 set x end--1
1619 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1620 } {{} {}}
1622 test lindex-4.3 {index = end-0} {
1623 set x end-0
1624 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1625 } {c c}
1627 test lindex-4.4 {index = end-2} {
1628 set x end-2
1629 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1630 } {a a}
1632 test lindex-4.5 {index = end-3} {
1633 set x end-3
1634 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1635 } {{} {}}
1637 test lindex-4.8 {bad integer, not octal} {
1638 set x end-0a2
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} {
1643 # set x en
1644 # list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1645 #} {c c}
1647 test lindex-4.10 {incomplete end-} {
1648 set x 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]
1666 } {b c}
1667 test lindex-7.2 {quoted elements} {
1668 eval [list $lindex {"{}" b c} 0]
1669 } {{}}
1670 test lindex-7.3 {quoted elements} {
1671 eval [list $lindex {ab "c d \" x" y} 1]
1672 } {c d " x}
1673 test lindex-7.4 {quoted elements} {
1674 lindex {a b {c d "e} {f g"}} 2
1675 } {c d "e}
1677 test lindex-8.1 {data reuse} {
1678 set x 0
1679 eval [list $lindex $x $x]
1680 } {0}
1682 test lindex-8.2 {data reuse} {
1683 set a 0
1684 eval [list $lindex $a $a $a]
1686 test lindex-8.3 {data reuse} {
1687 set a 1
1688 eval [list $lindex $a $a $a]
1689 } {}
1691 #----------------------------------------------------------------------
1693 test lindex-10.2 {singleton index list} {
1694 set x { 1 }
1695 catch {
1696 list [lindex {a b c} $x] [lindex {a b c} $x]
1697 } result
1698 set result
1699 } {b b}
1701 test lindex-10.4 {malformed index list} {
1702 set x \{
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} {
1709 set x ${minus}1
1710 catch {
1711 list [lindex {a b c} $x] [lindex {a b c} $x]
1712 } result
1713 set result
1714 } {{} {}}
1716 test lindex-11.2 {integer 0} {
1717 set x [string range 00 0 0]
1718 catch {
1719 list [lindex {a b c} $x] [lindex {a b c} $x]
1720 } result
1721 set result
1722 } {a a}
1724 test lindex-11.3 {integer 2} {
1725 set x [string range 22 0 0]
1726 catch {
1727 list [lindex {a b c} $x] [lindex {a b c} $x]
1728 } result
1729 set result
1730 } {c c}
1732 test lindex-11.4 {integer 3} {
1733 set x [string range 33 0 0]
1734 catch {
1735 list [lindex {a b c} $x] [lindex {a b c} $x]
1736 } result
1737 set result
1738 } {{} {}}
1740 # Indices relative to end
1741 test lindex-12.1 {index = end} {
1742 set x end
1743 catch {
1744 list [lindex {a b c} $x] [lindex {a b c} $x]
1745 } result
1746 set result
1747 } {c c}
1749 test lindex-12.2 {index = end--1} {
1750 set x end--1
1751 catch {
1752 list [lindex {a b c} $x] [lindex {a b c} $x]
1753 } result
1754 set result
1755 } {{} {}}
1757 test lindex-12.3 {index = end-0} {
1758 set x end-0
1759 catch {
1760 list [lindex {a b c} $x] [lindex {a b c} $x]
1761 } result
1762 set result
1763 } {c c}
1765 test lindex-12.4 {index = end-2} {
1766 set x end-2
1767 catch {
1768 list [lindex {a b c} $x] [lindex {a b c} $x]
1769 } result
1770 set result
1771 } {a a}
1773 test lindex-12.5 {index = end-3} {
1774 set x end-3
1775 catch {
1776 list [lindex {a b c} $x] [lindex {a b c} $x]
1777 } result
1778 set result
1779 } {{} {}}
1781 test lindex-12.8 {bad integer, not octal} {
1782 set x end-0a2
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-} {
1787 set x 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} {
1796 catch {
1797 lindex {{a b c} {d e f} {g h i}} 1 2
1798 } result
1799 set result
1802 test lindex-13.3 {three indices} {
1803 catch {
1804 lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1
1805 } result
1806 set result
1809 test lindex-15.1 {quoted elements} {
1810 catch {
1811 lindex {a "b c" d} 1
1812 } result
1813 set result
1814 } {b c}
1815 test lindex-15.2 {quoted elements} {
1816 catch {
1817 lindex {"{}" b c} 0
1818 } result
1819 set result
1820 } {{}}
1821 test lindex-15.3 {quoted elements} {
1822 catch {
1823 lindex {ab "c d \" x" y} 1
1824 } result
1825 set result
1826 } {c d " x}
1827 test lindex-15.4 {quoted elements} {
1828 catch {
1829 lindex {a b {c d "e} {f g"}} 2
1830 } result
1831 set result
1832 } {c d "e}
1834 test lindex-16.1 {data reuse} {
1835 set x 0
1836 catch {
1837 lindex $x $x
1838 } result
1839 set result
1840 } {0}
1842 test lindex-16.2 {data reuse} {
1843 set a 0
1844 catch {
1845 lindex $a $a $a
1846 } result
1847 set result
1849 test lindex-16.3 {data reuse} {
1850 set a 1
1851 catch {
1852 lindex $a $a $a
1853 } result
1854 set result
1855 } {}
1857 catch { unset lindex}
1858 catch { unset minus }
1860 ################################################################################
1861 # LINDEX
1862 ################################################################################
1864 catch {unset a}
1865 catch {unset x}
1867 # Basic "foreach" operation.
1869 test foreach-1.1 {basic foreach tests} {
1870 set a {}
1871 foreach i {a b c d} {
1872 set a [concat $a $i]
1874 set a
1875 } {a b c d}
1876 test foreach-1.2 {basic foreach tests} {
1877 set a {}
1878 foreach i {a b {{c d} e} {123 {{x}}}} {
1879 set a [concat $a $i]
1881 set a
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} {
1888 set a {}
1889 foreach i {} {
1890 set a [concat $a $i]
1892 set a
1893 } {}
1894 catch {unset a}
1895 test foreach-2.1 {foreach errors} {
1896 list [catch {foreach {} {} {}} msg] $msg
1897 } {1 {foreach varlist is empty}}
1898 catch {unset a}
1900 test foreach-3.1 {parallel foreach tests} {
1901 set x {}
1902 foreach {a b} {1 2 3 4} {
1903 append x $b $a
1905 set x
1906 } {2143}
1907 test foreach-3.2 {parallel foreach tests} {
1908 set x {}
1909 foreach {a b} {1 2 3 4 5} {
1910 append x $b $a
1912 set x
1913 } {21435}
1914 test foreach-3.3 {parallel foreach tests} {
1915 set x {}
1916 foreach a {1 2 3} b {4 5 6} {
1917 append x $b $a
1919 set x
1920 } {415263}
1921 test foreach-3.4 {parallel foreach tests} {
1922 set x {}
1923 foreach a {1 2 3} b {4 5 6 7 8} {
1924 append x $b $a
1926 set x
1927 } {41526378}
1928 test foreach-3.5 {parallel foreach tests} {
1929 set x {}
1930 foreach {a b} {a b A B aa bb} c {c C cc CC} {
1931 append x $a $b $c
1933 set x
1934 } {abcABCaabbccCC}
1935 test foreach-3.6 {parallel foreach tests} {
1936 set x {}
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
1940 set x
1941 } {111112222233333}
1942 test foreach-3.7 {parallel foreach tests} {
1943 set x {}
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
1947 set x
1948 } {1111 2222334}
1949 test foreach-4.1 {foreach only sets vars if repeating loop} {
1950 proc foo {} {
1951 set rgb {65535 0 0}
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} {
1958 proc foo {} {
1959 set x {}
1960 foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]}
1961 list $a $x
1964 } {{3 4} {1 2 3 4}}
1966 test foreach-6.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
1967 catch {unset x}
1968 foreach {12.0} {a b c} {
1969 set x 12.0
1970 set x [expr $x + 1]
1972 set x
1973 } 13.0
1975 # Check "continue".
1977 test foreach-7.1 {continue tests} {catch continue} 4
1978 test foreach-7.2 {continue tests} {
1979 set a {}
1980 foreach i {a b c d} {
1981 if {[string compare $i "b"] == 0} continue
1982 set a [concat $a $i]
1984 set a
1985 } {a c d}
1986 test foreach-7.3 {continue tests} {
1987 set a {}
1988 foreach i {a b c d} {
1989 if {[string compare $i "b"] != 0} continue
1990 set a [concat $a $i]
1992 set a
1993 } {b}
1994 test foreach-7.4 {continue tests} {catch {continue foo} msg} 1
1995 test foreach-7.5 {continue tests} {
1996 catch {continue foo} msg
1997 set msg
1998 } {wrong # args: should be "continue"}
2000 # Check "break".
2002 test foreach-8.1 {break tests} {catch break} 3
2003 test foreach-8.2 {break tests} {
2004 set a {}
2005 foreach i {a b c d} {
2006 if {[string compare $i "c"] == 0} break
2007 set a [concat $a $i]
2009 set a
2010 } {a b}
2011 test foreach-8.3 {break tests} {catch {break foo} msg} 1
2012 test foreach-8.4 {break tests} {
2013 catch {break foo} msg
2014 set msg
2015 } {wrong # args: should be "break"}
2017 # Test for incorrect "double evaluation" semantics
2019 test foreach-9.1 {delayed substitution of body - knownbugs} {
2020 proc foo {} {
2021 set a 0
2022 foreach a [list 1 2 3] "
2023 set x $a
2025 set x
2028 } {0}
2030 # cleanup
2031 catch {unset a}
2032 catch {unset x}
2034 ################################################################################
2035 # STRING
2036 ################################################################################
2038 # string last
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
2060 ## string match
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}
2076 # foo
2077 #} 0
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}
2188 # foo
2189 #} 1
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 "*\\" "\\"}
2227 # foo
2228 #} 0
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 "\\" "\\"}
2259 # foo
2260 #} 0
2262 ## string length
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"}
2275 } 15
2277 # string map
2279 test string-10.4 {string map} {
2280 string map {a b} abba
2281 } {bbbb}
2282 test string-10.5 {string map} {
2283 string map {a b} a
2284 } {b}
2285 test string-10.6 {string map -nocase} {
2286 string map -nocase {a b} Abba
2287 } {bbbb}
2288 test string-10.7 {string map} {
2289 string map {abc 321 ab * a A} aabcabaababcab
2290 } {A321*A*321*}
2291 test string-10.8 {string map -nocase} {
2292 string map -nocase {aBc 321 Ab * a A} aabcabaababcab
2293 } {A321*A*321*}
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}
2299 } {qwerty}
2300 test string-10.12 {string map, unicode} {
2301 string map [list \374 ue UE \334] "a\374ueUE\000EU"
2302 } aueue\334\0EU
2303 test string-10.13 {string map, -nocase unicode} {
2304 string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"
2305 } aue\334\334\0EU
2306 test string-10.14 {string map, -nocase null arguments} {
2307 string map -nocase {{} abc} foo
2308 } foo
2309 test string-10.15 {string map, one pair case} {
2310 string map -nocase {abc 32} aAbCaBaAbAbcAb
2311 } {a32aBaAb32Ab}
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
2320 } foo
2321 test string-10.19 {string map, empty arguments} {
2322 string map -nocase {{} abc f bar {} def} foo
2323 } baroo
2325 ################################################################################
2326 # SPLIT
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} {
2336 split "12345" {}
2337 } {1 2 3 4 5}
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} {
2342 split {} {}
2343 } {}
2344 test split-1.6 {basic split commands} {
2345 split {}
2346 } {}
2347 test split-1.7 {basic split commands} {
2348 split { }
2349 } {{} {} {} {}}
2350 test split-1.8 {basic split commands} {
2351 proc foo {} {
2352 set x {}
2353 foreach f [split {]\n} {}] {
2354 append x $f
2356 return $x
2359 } {]\n}
2360 test split-1.9 {basic split commands} {
2361 proc foo {} {
2362 set x ab\000c
2363 set y [split $x {}]
2364 return $y
2367 } "a b \000 c"
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} {
2372 split "12,3,45" {,}
2373 } {12 3 45}
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," {,}
2379 } {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?"}}
2391 # cleanup
2392 catch {rename foo {}}
2394 ################################################################################
2395 # JOIN
2396 ################################################################################
2398 test join-1.1 {basic join commands} {
2399 join {a b c} xyz
2400 } axyzbxyzc
2401 test join-1.2 {basic join commands} {
2402 join {a b c} {}
2403 } abc
2404 test join-1.3 {basic join commands} {
2405 join {} xyz
2406 } {}
2407 test join-1.4 {basic join commands} {
2408 join {12 34 56}
2409 } {12 34 56}
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"]
2427 } 11
2429 ################################################################################
2430 # SWITCH
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}
2444 } {}
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} {
2456 switch b {
2457 a {expr 1}
2458 b {expr 2}
2459 default {expr 6}
2461 } {2}
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}
2469 *b {concat glob}
2470 aaaab {concat exact}
2471 default {concat none}
2473 } exact
2474 test switch-3.2 {-exact vs. -glob vs. -regexp (no [regexp] cmd)} {
2475 rename regexp regexp.none
2476 set rc [catch {
2477 switch -regexp aaaab {
2478 ^a*b$ {concat regexp}
2479 *b {concat glob}
2480 aaaab {concat exact}
2481 default {concat none}
2484 rename regexp.none regexp
2485 set rc
2488 test switch-3.3 {-exact vs. -glob vs. -regexp (with [regexp] cmd)} {
2489 switch -regexp aaaab {
2490 ^a*b$ {concat regexp}
2491 *b {concat glob}
2492 aaaab {concat exact}
2493 default {concat none}
2495 } regexp
2496 test switch-3.4 {-exact vs. -glob vs. -regexp} {
2497 switch -glob aaaab {
2498 ^a*b$ {concat regexp}
2499 *b {concat glob}
2500 aaaab {concat exact}
2501 default {concat none}
2503 } glob
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}
2507 } exact
2508 test switch-3.6 {-exact vs. -glob vs. -regexp} {
2509 switch -- -glob {
2510 ^g.*b$ {concat regexp}
2511 -* {concat glob}
2512 -glob {concat exact}
2513 default {concat none}
2515 } exact
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] \
2522 $msg
2523 } {1 {Just a test}}
2524 test switch-4.2 {error: not enough args} {
2525 catch {switch}
2527 test switch-4.3 {error: pattern with no body} {
2528 catch {switch a b}
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
2536 } {1 switch2}
2538 #~ test switch-5.1 {errors in -regexp matching} {
2539 #~ list [catch {switch -regexp aaaab {
2540 #~ *b {concat glob}
2541 #~ aaaab {concat exact}
2542 #~ default {concat none}
2543 #~ }} msg] $msg
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}
2555 } third
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}
2563 } second
2565 test switch-7.1 {"-" bodies} {
2566 switch a {
2569 c {concat 1}
2570 default {concat 2}
2573 test switch-7.2 {"-" bodies} {
2574 list [catch {
2575 switch a {
2580 } msg] $msg
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} {
2584 #~ list [catch {
2585 #~ switch a {
2586 #~ a -
2587 #~ b -foo
2588 #~ c -
2589 #~ }
2590 #~ } msg] $msg
2591 #~ } {1 {no body specified for pattern "c"}}
2592 test switch-7.3 {"-" bodies} {
2593 list [catch {
2594 switch a {
2596 b -foo
2599 } msg] $msg
2600 } {1 {invalid command name "-foo"}}
2602 test switch-8.1 {empty body} {
2603 set msg {}
2604 switch {2} {
2605 1 {set msg 1}
2606 2 {}
2607 default {set msg 2}
2609 } {}
2611 test switch-9.1 {empty pattern/body list} {
2612 catch {switch x}
2614 test switch-9.2 {empty pattern/body list} {
2615 catch {switch -- x}
2616 } 1
2617 test switch-9.3 {empty pattern/body list} {
2618 catch {switch x {}}
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}
2650 } {}
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} {
2655 list [catch {
2656 switch -command [lambda {p1 p2} {error "foo"}] a a {expr 1} b {expr 2}
2657 } msg] $msg
2658 } {1 foo}
2659 test switch-10.6 {[continue] in callback to -command} {
2660 list [catch {
2661 switch -command [lambda {p1 p2} {continue}] a a {expr 1} b {expr 2}
2662 } msg] $msg
2663 } {4 {}}
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}
2667 } {}
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 ################################################################################
2678 # FOR
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"}}
2689 catch {unset i}
2690 test for-1.3 {TclCompileForCmd: missing test expression} {
2691 catch {for {set i 0}} msg
2692 set msg
2693 } {wrong # args: should be "for start test next body"}
2694 test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
2695 set i 0
2696 for {} "$i > 5" {incr i} {}
2697 } {}
2698 test for-1.6 {TclCompileForCmd: missing "next" command} {
2699 catch {for {set i 0} {$i < 5}} msg
2700 set 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
2704 set msg
2705 } {wrong # args: should be "for start test next body"}
2706 catch {unset a}
2707 test for-1.9 {TclCompileForCmd: simple command body} {
2708 set a {}
2709 for {set i 1} {$i<6} {set i [expr $i+1]} {
2710 if $i==4 break
2711 set a [concat $a $i]
2713 set a
2714 } {1 2 3}
2715 test for-1.10 {TclCompileForCmd: command body in quotes} {
2716 set a {}
2717 for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2718 set a
2719 } {xxxxx}
2720 test for-1.11 {TclCompileForCmd: computed command body} {
2721 catch {unset x1}
2722 catch {unset bb}
2723 catch {unset x2}
2724 set x1 {append a x1; }
2725 set bb {break}
2726 set x2 {; append a x2}
2727 set a {}
2728 for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
2729 set a
2730 } {x1}
2731 test for-1.13 {TclCompileForCmd: long command body} {
2732 set a {}
2733 for {set i 1} {$i<6} {set i [expr $i+1]} {
2734 if $i==4 break
2735 if $i>5 continue
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]
2764 set a
2765 } {1 2 3}
2766 test for-1.14 {TclCompileForCmd: for command result} {
2767 set a [for {set i 0} {$i < 5} {incr i} {}]
2768 set a
2769 } {}
2770 test for-1.15 {TclCompileForCmd: for command result} {
2771 set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
2772 set a
2773 } {}
2775 # Check "for" and "continue".
2777 test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
2778 catch {continue foo} msg
2779 set msg
2780 } {wrong # args: should be "continue"}
2781 test for-2.2 {TclCompileContinueCmd: continue result} {
2782 catch continue
2784 test for-2.3 {continue tests} {
2785 set a {}
2786 for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2787 if {$i == 2} continue
2788 set a [concat $a $i]
2790 set a
2791 } {1 3 4}
2792 test for-2.4 {continue tests} {
2793 set a {}
2794 for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2795 if {$i != 2} continue
2796 set a [concat $a $i]
2798 set a
2799 } {2}
2800 test for-2.5 {continue tests, nested loops} {
2801 set msg {}
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"]
2808 set msg
2809 } {1.1 1.2 2.1 3.1 4.1}
2810 test for-2.6 {continue tests, long command body} {
2811 set a {}
2812 for {set i 1} {$i<6} {set i [expr $i+1]} {
2813 if $i==2 continue
2814 if $i==4 break
2815 if $i>5 continue
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]
2843 set a
2844 } {1 3}
2846 # Check "for" and "break".
2848 test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
2849 catch {break foo} msg
2850 set msg
2851 } {wrong # args: should be "break"}
2852 test for-3.2 {TclCompileBreakCmd: break result} {
2853 catch break
2855 test for-3.3 {break tests} {
2856 set a {}
2857 for {set i 1} {$i <= 4} {incr i} {
2858 if {$i == 3} break
2859 set a [concat $a $i]
2861 set a
2862 } {1 2}
2863 test for-3.4 {break tests, nested loops} {
2864 set msg {}
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"]
2871 set msg
2872 } {1.1 1.2 2.1 3.1 4.1}
2873 test for-3.5 {break tests, long command body} {
2874 set a {}
2875 for {set i 1} {$i<6} {set i [expr $i+1]} {
2876 if $i==2 continue
2877 if $i==5 break
2878 if $i>5 continue
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
2894 if {$i == 4} break
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]
2907 set a
2908 } {1 3}
2909 test for-4.1 {break must reset the interp result} {
2910 catch {
2911 set z GLOBTESTDIR/dir2/file2.c
2912 if [string match GLOBTESTDIR/dir2/* $z] {
2913 break
2916 set j
2917 } {}
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
2923 catch {unset a}
2924 catch {unset i}
2925 set a 5
2926 set i {}
2927 for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2928 set i
2929 } {1 6 11}
2931 test for-5.2 {possible delayed substitution of increment command} {
2932 # Increment should be 5, and lappend should always append $a
2933 catch {rename p ""}
2934 proc p {} {
2935 set a 5
2936 set i {}
2937 for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2938 set i
2941 } {1 6 11}
2942 test for-5.3 {possible delayed substitution of body command} {
2943 # Increment should be $a, and lappend should always append 5
2944 set a 5
2945 set i {}
2946 for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2947 set i
2948 } {5 5 5 5}
2949 test for-5.4 {possible delayed substitution of body command} {
2950 # Increment should be $a, and lappend should always append 5
2951 catch {rename p ""}
2952 proc p {} {
2953 set a 5
2954 set i {}
2955 for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2956 set i
2959 } {5 5 5 5}
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} {
2966 set z for
2967 catch {$z} msg
2968 set msg
2969 } {wrong # args: should be "for start test next body"}
2970 test for-6.2 {Tcl_ForObjCmd: number of args} {
2971 set z for
2972 catch {$z {set i 0}} msg
2973 set msg
2974 } {wrong # args: should be "for start test next body"}
2975 test for-6.3 {Tcl_ForObjCmd: number of args} {
2976 set z for
2977 catch {$z {set i 0} {$i < 5}} msg
2978 set msg
2979 } {wrong # args: should be "for start test next body"}
2980 test for-6.4 {Tcl_ForObjCmd: number of args} {
2981 set z for
2982 catch {$z {set i 0} {$i < 5} {incr i}} msg
2983 set msg
2984 } {wrong # args: should be "for start test next body"}
2985 test for-6.5 {Tcl_ForObjCmd: number of args} {
2986 set z for
2987 catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
2988 set msg
2989 } {wrong # args: should be "for start test next body"}
2990 test for-6.6 {Tcl_ForObjCmd: error in initial command} {
2991 set z for
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} {
2995 set z for
2996 set i 0
2997 $z {set i 6} "$i > 5" {incr i} {set y $i}
2998 set i
3000 test for-6.10 {Tcl_ForObjCmd: simple command body} {
3001 set z for
3002 set a {}
3003 $z {set i 1} {$i<6} {set i [expr $i+1]} {
3004 if $i==4 break
3005 set a [concat $a $i]
3007 set a
3008 } {1 2 3}
3009 test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
3010 set z for
3011 set a {}
3012 $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
3013 set a
3014 } {xxxxx}
3015 test for-6.12 {Tcl_ForObjCmd: computed command body} {
3016 set z for
3017 catch {unset x1}
3018 catch {unset bb}
3019 catch {unset x2}
3020 set x1 {append a x1; }
3021 set bb {break}
3022 set x2 {; append a x2}
3023 set a {}
3024 $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
3025 set a
3026 } {x1}
3027 test for-6.14 {Tcl_ForObjCmd: long command body} {
3028 set z for
3029 set a {}
3030 $z {set i 1} {$i<6} {set i [expr $i+1]} {
3031 if $i==4 break
3032 if $i>5 continue
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]
3060 set a
3061 } {1 2 3}
3062 test for-6.15 {Tcl_ForObjCmd: for command result} {
3063 set z for
3064 set a [$z {set i 0} {$i < 5} {incr i} {}]
3065 set a
3066 } {}
3067 test for-6.16 {Tcl_ForObjCmd: for command result} {
3068 set z for
3069 set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
3070 set a
3071 } {}
3073 ################################################################################
3074 # INFO
3075 ################################################################################
3077 test info-1.1 {info body option} {
3078 proc t1 {} {body of t1}
3079 info body t1
3080 } {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} {
3088 catch {unset args}
3089 proc foo {args} {
3090 foreach v $args {
3091 upvar $v var
3092 return "variable $v existence: [info exists var]"
3095 foo a
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]]
3102 } {9 9}
3103 test info-2.1 {info commands option} {
3104 proc t1 {} {}
3105 proc t2 {} {}
3106 set x " [info commands] "
3107 list [string match {* t1 *} $x] [string match {* t2 *} $x] \
3108 [string match {* set *} $x] [string match {* list *} $x]
3109 } {1 1 1 1}
3110 test info-2.2 {info commands option} {
3111 proc t1 {} {}
3112 rename t1 {}
3113 set x [info commands]
3114 string match {* t1 *} $x
3116 test info-2.3 {info commands option} {
3117 proc _t1_ {} {}
3118 proc _t2_ {} {}
3119 info commands _t1_
3120 } _t1_
3121 test info-2.4 {info commands option} {
3122 proc _t1_ {} {}
3123 proc _t2_ {} {}
3124 lsort [info commands _t*]
3125 } {_t1_ _t2_}
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} {
3132 set value foo
3133 info exists value
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]}
3141 t1 2
3143 test info-3.4 {info exists option} {
3144 proc t1 {x} {
3145 global _nonexistent_
3146 return [info exists _nonexistent_]
3148 t1 2
3150 test info-3.5 {info exists option} {
3151 proc t1 {x} {
3152 set y 47
3153 return [info exists y]
3155 t1 2
3157 test info-3.6 {info exists option} {
3158 proc t1 {x} {return [info exists value]}
3159 t1 2
3161 test info-3.7 {info exists option} {
3162 catch {unset x}
3163 set x(2) 44
3164 list [info exists x] [info exists x(1)] [info exists x(2)]
3165 } {1 0 1}
3166 catch {unset x}
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} {
3174 set x 1
3175 set y 2
3176 set value 23
3177 set a " [info globals] "
3178 list [string match {* x *} $a] [string match {* y *} $a] \
3179 [string match {* value *} $a] [string match {* _foobar_ *} $a]
3180 } {1 1 1 0}
3181 test info-4.2 {info globals option} {
3182 set _xxx1 1
3183 set _xxx2 2
3184 lsort [info globals _xxx*]
3185 } {_xxx1 _xxx2}
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} {
3190 info level
3193 test info-5.2 {info level option} {
3194 proc t1 {a b} {
3195 set x [info level]
3196 set y [info level 1]
3197 list $x $y
3199 t1 146 testString
3200 } {1 {t1 146 testString}}
3201 test info-5.3 {info level option} {
3202 proc t1 {a b} {
3203 t2 [expr $a*2] $b
3205 proc t2 {x y} {
3206 list [info level] [info level 1] [info level 2] [info level -1] \
3207 [info level 0]
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} {
3212 proc t1 {} {
3213 set x [info level]
3214 set y [info level 1]
3215 list $x $y
3218 } {1 t1}
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} {
3237 set a 22
3238 proc t1 {x y} {
3239 set b 13
3240 set c testing
3241 global a
3242 global aa
3243 set aa 23
3244 return [info locals]
3246 lsort [t1 23 24]
3247 } {b c x y}
3248 test info-6.2 {info locals option} {
3249 proc t1 {x y} {
3250 set xx1 2
3251 set xx2 3
3252 set y 4
3253 return [info locals x*]
3255 lsort [t1 2 3]
3256 } {x xx1 xx2}
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} {
3261 info locals
3262 } {}
3263 test info-6.5 {info locals option} {
3264 proc t1 {} {return [info locals]}
3266 } {}
3267 test info-6.6 {info locals vs unset compiled locals} {
3268 proc t1 {lst} {
3269 foreach $lst $lst {}
3270 unset lst
3271 return [info locals]
3273 lsort [t1 {a b c c d e f}]
3274 } {a b c d e f}
3275 test info-6.7 {info locals with temporary variables} {
3276 proc t1 {} {
3277 foreach a {b c} {}
3278 info locals
3281 } {a}
3282 test info-7.1 {info vars option} {
3283 set a 1
3284 set b 2
3285 proc t1 {x y} {
3286 global a b
3287 set c 33
3288 return [info vars]
3290 lsort [t1 18 19]
3291 } {a b c x y}
3292 test info-7.2 {info vars option} {
3293 set xxx1 1
3294 set xxx2 2
3295 proc t1 {xxa y} {
3296 global xxx1 xxx2
3297 set c 33
3298 return [info vars x*]
3300 lsort [t1 18 19]
3301 } {xxa xxx1 xxx2}
3302 test info-7.3 {info vars option} {
3303 lsort [info vars]
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} {
3309 proc t1 {} {
3310 foreach a {b c} {}
3311 info vars
3314 } {a}
3317 ################################################################################
3318 # linsert
3319 ################################################################################
3321 test linsert-1.1 {linsert command} {
3322 linsert {1 2 3 4 5} 0 a
3323 } {a 1 2 3 4 5}
3324 test linsert-1.2 {linsert command} {
3325 linsert {1 2 3 4 5} 1 a
3326 } {1 a 2 3 4 5}
3327 test linsert-1.3 {linsert command} {
3328 linsert {1 2 3 4 5} 2 a
3329 } {1 2 a 3 4 5}
3330 test linsert-1.4 {linsert command} {
3331 linsert {1 2 3 4 5} 3 a
3332 } {1 2 3 a 4 5}
3333 test linsert-1.5 {linsert command} {
3334 linsert {1 2 3 4 5} 4 a
3335 } {1 2 3 4 a 5}
3336 test linsert-1.6 {linsert command} {
3337 linsert {1 2 3 4 5} 5 a
3338 } {1 2 3 4 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} {
3349 linsert {} 2 a b c
3350 } {a b c}
3351 test linsert-1.11 {linsert command} {
3352 linsert {} 2 {}
3353 } {{}}
3354 test linsert-1.12 {linsert command} {
3355 linsert {a b "c c" d e} 3 1
3356 } {a b {c c} 1 d e}
3357 test linsert-1.13 {linsert command} {
3358 linsert { a b c d} 0 1 2
3359 } {1 2 a b c d}
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
3371 } {a b c q r}
3372 test linsert-1.18 {linsert command} {
3373 linsert {a} end q r
3374 } {a q r}
3375 test linsert-1.19 {linsert command} {
3376 linsert {} end q r
3377 } {q r}
3378 test linsert-1.20 {linsert command, use of end-int index} {
3379 linsert {a b c d} end-2 e f
3380 } {a b e f c d}
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} {
3393 proc p {} {
3394 linsert "a b c" 1 "x y"
3395 return "a b c"
3398 } "a b c"
3399 test linsert-3.2 {linsert won't modify shared argument objects} {
3400 catch {unset lis}
3401 set lis [concat a \"b\" c]
3402 linsert $lis 0 [string length $lis]
3403 } "7 a b c"
3405 ################################################################################
3406 # LREPLACE
3407 ################################################################################
3409 test lreplace-1.1 {lreplace command} {
3410 lreplace {1 2 3 4 5} 0 0 a
3411 } {a 2 3 4 5}
3412 test lreplace-1.2 {lreplace command} {
3413 lreplace {1 2 3 4 5} 1 1 a
3414 } {1 a 3 4 5}
3415 test lreplace-1.3 {lreplace command} {
3416 lreplace {1 2 3 4 5} 2 2 a
3417 } {1 2 a 4 5}
3418 test lreplace-1.4 {lreplace command} {
3419 lreplace {1 2 3 4 5} 3 3 a
3420 } {1 2 3 a 5}
3421 test lreplace-1.5 {lreplace command} {
3422 lreplace {1 2 3 4 5} 4 4 a
3423 } {1 2 3 4 a}
3424 test lreplace-1.6 {lreplace command} {
3425 lreplace {1 2 3 4 5} 4 5 a
3426 } {1 2 3 4 a}
3427 test lreplace-1.7 {lreplace command} {
3428 lreplace {1 2 3 4 5} -1 -1 a
3429 } {a 1 2 3 4 5}
3430 test lreplace-1.8 {lreplace command} {
3431 lreplace {1 2 3 4 5} 2 end a b c d
3432 } {1 2 a b c d}
3433 test lreplace-1.9 {lreplace command} {
3434 lreplace {1 2 3 4 5} 0 3
3435 } {5}
3436 test lreplace-1.10 {lreplace command} {
3437 lreplace {1 2 3 4 5} 0 4
3438 } {}
3439 test lreplace-1.11 {lreplace command} {
3440 lreplace {1 2 3 4 5} 0 1
3441 } {3 4 5}
3442 test lreplace-1.12 {lreplace command} {
3443 lreplace {1 2 3 4 5} 2 3
3444 } {1 2 5}
3445 test lreplace-1.13 {lreplace command} {
3446 lreplace {1 2 3 4 5} 3 end
3447 } {1 2 3}
3448 test lreplace-1.14 {lreplace command} {
3449 lreplace {1 2 3 4 5} -1 4 a b c
3450 } {a b c}
3451 test lreplace-1.15 {lreplace command} {
3452 lreplace {a b "c c" d e f} 3 3
3453 } {a b {c c} e f}
3454 test lreplace-1.16 {lreplace command} {
3455 lreplace { 1 2 3 4 5} 0 0 a
3456 } {a 2 3 4 5}
3457 test lreplace-1.17 {lreplace command} {
3458 lreplace {1 2 3 4 "5 6"} 4 4 a
3459 } {1 2 3 4 a}
3460 test lreplace-1.18 {lreplace command} {
3461 lreplace {1 2 3 4 {5 6}} 4 4 a
3462 } {1 2 3 4 a}
3463 test lreplace-1.19 {lreplace command} {
3464 lreplace {1 2 3 4} 2 end x y z
3465 } {1 2 x y z}
3466 test lreplace-1.20 {lreplace command} {
3467 lreplace {1 2 3 4} end end a
3468 } {1 2 3 a}
3469 test lreplace-1.21 {lreplace command} {
3470 lreplace {1 2 3 4} end 3 a
3471 } {1 2 3 a}
3472 test lreplace-1.22 {lreplace command} {
3473 lreplace {1 2 3 4} end end
3474 } {1 2 3}
3475 test lreplace-1.23 {lreplace command} {
3476 lreplace {1 2 3 4} 2 -1 xy
3477 } {1 2 xy 3 4}
3478 test lreplace-1.24 {lreplace command} {
3479 lreplace {1 2 3 4} end -1 z
3480 } {1 2 3 z 4}
3481 test lreplace-1.25 {lreplace command} {
3482 concat \"[lreplace {\}\ hello} end end]\"
3483 } {"\}\ "}
3484 test lreplace-1.26 {lreplace command} {
3485 catch {unset foo}
3486 set foo {a b}
3487 list [set foo [lreplace $foo end end]] \
3488 [set foo [lreplace $foo end end]] \
3489 [set foo [lreplace $foo end end]]
3490 } {a {} {}}
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} {
3516 proc p {} {
3517 lreplace "a b c" 1 1 "x y"
3518 return "a b c"
3521 } "a b c"
3523 ################################################################################
3524 # LRANGE
3525 ################################################################################
3527 test lrange-1.1 {range of list elements} {
3528 lrange {a b c d} 1 2
3529 } {b c}
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
3535 } {l15 d}
3536 test lrange-1.4 {range of list elements} {
3537 lrange {a {bcd e {f g {}}} l14 l15 d} 4 10000
3538 } {d}
3539 test lrange-1.5 {range of list elements} {
3540 lrange {a {bcd e {f g {}}} l14 l15 d} 4 3
3541 } {}
3542 test lrange-1.6 {range of list elements} {
3543 lrange {a {bcd e {f g {}}} l14 l15 d} 10 11
3544 } {}
3545 test lrange-1.7 {range of list elements} {
3546 lrange {a b c d e} -1 2
3547 } {a b c}
3548 test lrange-1.8 {range of list elements} {
3549 lrange {a b c d e} -2 -1
3550 } {}
3551 test lrange-1.9 {range of list elements} {
3552 lrange {a b c d e} -2 end
3553 } {a b c d e}
3554 test lrange-1.10 {range of list elements} {
3555 lrange "a b\{c d" 1 2
3556 } "b\\{c d"
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
3568 } {}
3569 test lrange-1.15 {range of list elements} {
3570 concat \"[lrange {a b \{\ } 0 2]"
3571 } {"a b \{\ "}
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 ################################################################################
3596 # REGEXP and REGSUB
3597 ################################################################################
3599 test regexp-1.1 {basic regexp operation} {
3600 regexp ab*c abbbc
3601 } {1}
3603 test regexp-1.2 {basic regexp operation} {
3604 regexp ab*c ac
3605 } {1}
3607 test regexp-1.3 {basic regexp operation} {
3608 regexp ab*c ab
3609 } {0}
3611 test regexp-1.4 {basic regexp operation} {
3612 regexp -- -gorp abc-gorpxxx
3613 } {1}
3615 test regexp-1.5 {basic regexp operation} {
3616 regexp {^([^ ]*)[ ]*([^ ]*)} "" a
3617 } {1}
3619 # This null case doesn't work with some regex libraries
3620 # No great loss
3621 #test regexp-1.6 {basic regexp operation} {
3622 # list [catch {regexp {} abc} msg] $msg
3623 #} {0 1}
3625 test regexp-2.1 {getting substrings back from regexp} {
3626 set foo {}
3627 list [regexp ab*c abbbbc foo] $foo
3628 } {1 abbbbc}
3630 test regexp-2.2 {getting substrings back from regexp} {
3631 set foo {}
3632 set f2 {}
3633 list [regexp a(b*)c abbbbc foo f2] $foo $f2
3634 } {1 abbbbc bbbb}
3636 test regexp-2.3 {getting substrings back from regexp} {
3637 set foo {}
3638 set f2 {}
3639 list [regexp a(b*)(c) abbbbc foo f2] $foo $f2
3640 } {1 abbbbc bbbb}
3642 test regexp-2.4 {getting substrings back from regexp} {
3643 set foo {}
3644 set f2 {}
3645 set f3 {}
3646 list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
3647 } {1 abbbbc bbbb c}
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
3661 } {1 a a {} {}}
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
3666 } {1 ac a {} c}
3668 test regexp-2.8 {getting substrings back from regexp} {
3669 set match {}
3670 list [regexp {^a*b} aaaab match] $match
3671 } {1 aaaab}
3673 test regexp-3.1 {-indices option to regexp} {
3674 set foo {}
3675 list [regexp -indices ab*c abbbbc foo] $foo
3676 } {1 {0 5}}
3678 test regexp-3.2 {-indices option to regexp} {
3679 set foo {}
3680 set f2 {}
3681 list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2
3682 } {1 {0 5} {1 4}}
3684 test regexp-3.3 {-indices option to regexp} {
3685 set foo {}
3686 set f2 {}
3687 list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2
3688 } {1 {0 5} {1 4}}
3690 test regexp-3.4 {-indices option to regexp} {
3691 set foo {}
3692 set f2 {}
3693 set f3 {}
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*) \
3701 12223345556789999 \
3702 foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \
3703 $f6 $f7 $f8 $f9
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
3718 } {1}
3720 test regexp-4.2 {-nocase option to regexp} {
3721 set f1 22
3722 set f2 33
3723 set f3 44
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
3729 } {1}
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} {
3737 regexp .*a b
3738 regexp .*b c
3739 regexp .*c d
3740 regexp .*d e
3741 regexp .*e f
3742 regexp .*a bbba
3743 } {1}
3745 test regexp-5.2 {exercise cache of compiled expressions} {
3746 regexp .*a b
3747 regexp .*b c
3748 regexp .*c d
3749 regexp .*d e
3750 regexp .*e f
3751 regexp .*b xxxb
3752 } {1}
3754 test regexp-5.3 {exercise cache of compiled expressions} {
3755 regexp .*a b
3756 regexp .*b c
3757 regexp .*c d
3758 regexp .*d e
3759 regexp .*e f
3760 regexp .*c yyyc
3761 } {1}
3763 test regexp-5.4 {exercise cache of compiled expressions} {
3764 regexp .*a b
3765 regexp .*b c
3766 regexp .*c d
3767 regexp .*d e
3768 regexp .*e f
3769 regexp .*d 1d
3770 } {1}
3772 test regexp-5.5 {exercise cache of compiled expressions} {
3773 regexp .*a b
3774 regexp .*b c
3775 regexp .*c d
3776 regexp .*d e
3777 regexp .*e f
3778 regexp .*e xe
3779 } {1}
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
3803 } {0 1}
3805 test regexp-6.7 {regexp errors} {
3806 list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
3807 } {0 0}
3809 test regexp-6.8 {regexp errors} {
3810 catch {unset f1}
3811 set f1 44
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
3825 } {1 aaa111xaa}
3827 test regexp-7.3 {basic regsub operation} {
3828 list [regsub aa+ xaxaaa 111& foo] $foo
3829 } {1 xax111aaa}
3831 test regexp-7.4 {basic regsub operation} {
3832 list [regsub aa+ aaa 11&2&333 foo] $foo
3833 } {1 11aaa2aaa333}
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
3845 } {1 xax1aa22aaxaa}
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
3861 } {1 xax1&aaxaa}
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} {
3868 set foo xxx
3869 list [regsub abc xyz 111 foo] $foo
3870 } {0 xyz}
3872 test regexp-7.14 {basic regsub operation} {
3873 set foo xxx
3874 list [regsub ^ xyz "111 " foo] $foo
3875 } {1 {111 xyz}}
3877 test regexp-7.15 {basic regsub operation} {
3878 set foo xxx
3879 list [regsub -- -foo abc-foodef "111 " foo] $foo
3880 } {1 {abc111 def}}
3882 test regexp-7.16 {basic regsub operation} {
3883 set foo xxx
3884 list [regsub x "" y foo] $foo
3885 } {0 {}}
3887 test regexp-8.1 {case conversion in regsub} {
3888 list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
3889 } {1 xaAAaAAay}
3891 test regexp-8.2 {case conversion in regsub} {
3892 list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
3893 } {1 xaAAaAAay}
3895 test regexp-8.3 {case conversion in regsub} {
3896 set foo 123
3897 list [regsub a(a+) xaAAaAAay & foo] $foo
3898 } {0 xaAAaAAay}
3900 test regexp-8.4 {case conversion in regsub} {
3901 set foo 123
3902 list [regsub -nocase a CaDE b foo] $foo
3903 } {1 CbDE}
3905 test regexp-8.5 {case conversion in regsub} {
3906 set foo 123
3907 list [regsub -nocase XYZ CxYzD b foo] $foo
3908 } {1 CbD}
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
3913 set foo 123
3914 list [regsub -nocase $x $x b foo] $foo
3915 } {1 b}
3917 test regexp-9.1 {-all option to regsub} {
3918 set foo 86
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} {
3923 set foo 86
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} {
3928 set foo 86
3929 list [regsub x+ axxxbxxcxdx |&| foo] $foo
3930 } {1 a|xxx|bxxcxdx}
3932 test regexp-9.4 {-all option to regsub} {
3933 set foo 86
3934 list [regsub -all bc axxxbxxcxdx |&| foo] $foo
3935 } {0 axxxbxxcxdx}
3937 test regexp-9.5 {-all option to regsub} {
3938 set foo xxx
3939 list [regsub -all node "node node more" yy foo] $foo
3940 } {2 {yy yy more}}
3942 test regexp-9.6 {-all option to regsub} {
3943 set foo xxx
3944 list [regsub -all ^ xxx 123 foo] $foo
3945 } {1 123xxx}
3947 test regexp-10.2 {newline sensitivity in regsub} {
3948 set foo xxx
3949 list [regsub -line {^a.*b$} "dabc\naxyb\n" 123 foo] $foo
3950 } {1 {dabc
3954 test regexp-10.3 {newline sensitivity in regsub} {
3955 set foo xxx
3956 list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo
3957 } {1 {dabc
3959 xb}}
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} {
3986 catch {unset f1}
3987 set f1 44
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
4002 # is in use.
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
4009 set x done
4010 } {done}
4012 test regexp-14.1 {CompileRegexp: regexp cache} {
4013 regexp .*a b
4014 regexp .*b c
4015 regexp .*c d
4016 regexp .*d e
4017 regexp .*e f
4018 set x .
4019 append x *a
4020 regexp $x bbba
4021 } {1}
4023 test regexp-14.2 {CompileRegexp: regexp cache, different flags} {
4024 regexp .*a b
4025 regexp .*b c
4026 regexp .*c d
4027 regexp .*d e
4028 regexp .*e f
4029 set x .
4030 append x *a
4031 regexp -nocase $x bbba
4032 } {1}
4034 test regexp-15.1 {regexp -start} {
4035 catch {unset x}
4036 list [regexp -start -10 {[0-9]} 1abc2de3 x] $x
4037 } {1 1}
4039 test regexp-15.2 {regexp -start} {
4040 catch {unset x}
4041 list [regexp -start 2 {[0-9]} 1abc2de3 x] $x
4042 } {1 2}
4044 test regexp-15.3 {regexp -start} {
4045 catch {unset x}
4046 list [regexp -start 4 {[0-9]} 1abc2de3 x] $x
4047 } {1 2}
4049 test regexp-15.4 {regexp -start} {
4050 catch {unset x}
4051 list [regexp -start 5 {[0-9]} 1abc2de3 x] $x
4052 } {1 3}
4054 test regexp-15.5 {regexp -start, over end of string} {
4055 catch {unset x}
4056 list [regexp -start [string length 1abc2de3] {[0-9]} 1abc2de3 x] [info exists x]
4057 } {0 0}
4059 test regexp-15.6 {regexp -start, loss of ^$ behavior} {
4060 list [regexp -start 2 {^$} {}]
4061 } {1}
4063 test regexp-16.1 {regsub -start} {
4064 catch {unset x}
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} {
4069 catch {unset x}
4070 list [regsub -all -start -25 {z} hello {/&} x] $x
4071 } {0 hello}
4073 test regexp-16.3 {regsub -start} {
4074 catch {unset x}
4075 list [regsub -all -start 3 {z} hello {/&} x] $x
4076 } {0 hello}
4078 test regexp-17.1 {regexp -inline} {
4079 regexp -inline b ababa
4080 } {b}
4082 test regexp-17.2 {regexp -inline} {
4083 regexp -inline (b) ababa
4084 } {b b}
4086 test regexp-17.3 {regexp -inline -indices} {
4087 regexp -inline -indices (b) ababa
4088 } {{1 1} {1 1}}
4090 test regexp-17.4 {regexp -inline} {
4091 regexp -inline {[[:alnum:]_]([0-9]+)[[:alnum:]_]} " hello 23 there456def "
4092 } {e456d 456}
4094 test regexp-17.5 {regexp -inline no matches} {
4095 regexp -inline {[[:alnum:]_]([0-9]+)[[:alnum:]_]} ""
4096 } {}
4098 test regexp-17.6 {regexp -inline no matches} {
4099 regexp -inline hello goodbye
4100 } {}
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} {
4107 regexp -all b bbbbb
4108 } {5}
4110 test regexp-18.2 {regexp -all} {
4111 regexp -all b abababbabaaaaaaaaaab
4112 } {6}
4114 test regexp-18.3 {regexp -all -inline} {
4115 regexp -all -inline b abababbabaaaaaaaaaab
4116 } {b b b b b b}
4118 test regexp-18.4 {regexp -all -inline} {
4119 regexp -all -inline {[[:alnum:]_]([[:alnum:]_])} abcdefg
4120 } {ab b cd d ef f}
4122 test regexp-18.5 {regexp -all -inline} {
4123 regexp -all -inline {[[:alnum:]_]([[:alnum:]_])$} abcdefg
4124 } {fg g}
4126 test regexp-18.6 {regexp -all -inline} {
4127 regexp -all -inline {[0-9]+} 10:20:30:40
4128 } {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
4137 } {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
4147 } {a {}}
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
4158 } {a {} a}
4160 test regexp-18.11 {regexp -all} {
4161 regexp -all -inline {^a} aaaa
4162 } {a}
4164 test regexp-19.1 {regsub null replacement} {
4165 regsub -all {@} {@hel@lo@} "\0a\0" result
4166 list $result [string length $result]
4167 } {hello 5}
4170 ################################################################################
4171 # RANGE
4172 ################################################################################
4174 test range-1.1 {basic range tests} {
4175 range 0 10
4176 } {0 1 2 3 4 5 6 7 8 9}
4178 test range-1.2 {basic range tests} {
4179 range 10 0 -1
4180 } {10 9 8 7 6 5 4 3 2 1}
4182 test range-1.3 {basic range tests} {
4183 range 1 10 11
4184 } {1}
4186 test range-1.4 {basic range tests} {
4187 range 1 10 11
4188 } {1}
4190 test range-1.5 {basic range tests} {
4191 range 10 10
4192 } {}
4194 test range-1.6 {basic range tests} {
4195 range 10 10 2
4196 } {}
4198 test range-1.7 {basic range test} {
4199 range 5
4200 } {0 1 2 3 4}
4202 test range-1.8 {basic range test} {
4203 range -10 -20 -2
4204 } {-10 -12 -14 -16 -18}
4206 test range-1.9 {basic range test} {
4207 range -20 -10 3
4208 } {-20 -17 -14 -11}
4210 test range-2.0 {foreach range test} {
4211 set k 0
4212 foreach {x y} [range 100] {
4213 incr k [expr {$x*$y}]
4215 set k
4216 } {164150}
4218 test range-2.1 {foreach range test without obj reuse} {
4219 set k 0
4220 set trash {}
4221 foreach {x y} [range 100] {
4222 incr k [expr {$x*$y}]
4223 lappend trash $x $y
4225 set trash {}
4226 set k
4227 } {164150}
4229 test range-2.2 {range element shimmering test} {
4230 set k {}
4231 foreach x [range 0 10] {
4232 append k [llength $x]
4234 set k
4235 } {1111111111}
4237 test range-3.0 {llength range test} {
4238 llength [range 5000]
4239 } {5000}
4241 test range-3.1 {llength range test} {
4242 llength [range 5000 5000]
4243 } {0}
4245 test range-4.0 {lindex range test} {
4246 lindex [range 1000] 500
4247 } {500}
4249 test range-4.1 {lindex range test} {
4250 lindex [range 1000] end-2
4251 } {997}
4253 test range-5.0 {lindex llength range test} {
4254 set k 0
4255 set trash {}
4256 set r [range 100]
4257 for {set i 0} {$i < [llength $r]} {incr i 2} {
4258 incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}]
4260 set trash {}
4261 set k
4262 } {164150}
4264 ################################################################################
4265 # SCOPE
4266 ################################################################################
4267 if 0 {
4268 test scope-1.0 {Non existing var} {
4269 catch {unset x}
4270 scope x {
4271 set x 10
4272 set y [+ $x 1]
4274 list [info exists x] $y
4275 } {0 11}
4277 test scope-1.1 {Existing var restore} {
4278 set x 100
4279 scope x {
4280 for {set x 0} {$x < 10} {incr x} {}
4282 set x
4283 } {100}
4285 test scope-1.2 {Mix of 1.0 and 1.1 tests} {
4286 catch {unset x}
4287 set y 10
4288 scope {x y} {
4289 set y 100
4290 set x 200
4292 list [info exists x] $y
4293 } {0 10}
4295 test scope-1.3 {Array element} {
4296 set x "a 1 b 2"
4297 scope x(a) {
4298 set x(a) Hello!
4300 set x(a)
4301 } {1}
4303 test scope-1.4 {Non existing array element} {
4304 catch {unset x}
4305 scope x(a) {
4306 set x(a) Hello!
4308 info exists x(a)
4309 } {0}
4311 test scope-1.5 {Info exists} {
4312 set x foo
4313 scope x {
4314 info exists x
4316 } {0}
4318 catch {unset x}
4319 catch {unset y}
4322 ################################################################################
4323 # RAND
4324 ################################################################################
4325 test rand-1.0 {Only one output is valid} {
4326 list [rand 100 100] [rand 101 101]
4327 } {100 101}
4329 test rand-1.1 {invalid arguments} {
4330 catch {rand 100 50} err
4331 set err
4332 } {Invalid arguments (max < min)}
4334 test rand-1.2 {Check limits} {
4335 set sum 0
4336 for {set i 0} {$i < 100} {incr i} {
4337 incr sum [expr {([rand $i] >= 0)+([rand $i] < 100)}]
4339 set sum
4340 } {200}
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}} {
4349 incr y $x
4351 foobar 30
4352 foobar 20
4353 rename foobar barfoo
4354 list [barfoo 1] [barfoo 2] [barfoo 3]
4355 } {61 63 66}
4357 rename barfoo {}
4359 test regression-1.1 {lrange bug with negative indexes of type int} {
4360 lrange {a b c} 0 [- 0 1]
4361 } {}
4363 ################################################################################
4364 # FINAL REPORT
4365 ################################################################################
4367 puts "----------------------------------------------------------------------"
4368 puts "FAILED: $failedTests"
4369 foreach testId $failedList {
4370 puts "\t$testId"
4372 puts "PASSED: $passedTests"
4373 puts "----------------------------------------------------------------------\n"