lists: fix crash in ListInsertElements
[jimtcl.git] / test.tcl
blobfc7e6707f532fd29e6dc9e0ee2254d3c3b11e51a
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 result [uplevel 1 $script]
19 if {$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 ################################################################################
32 # SET
33 ################################################################################
35 test set-1.2 {TclCompileSetCmd: simple variable name} {
36 set i 10
37 list [set i] $i
38 } {10 10}
40 test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
41 set i 17
42 list [set "i"] $i
43 } {17 17}
45 test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} {
46 set x "i"
47 set i 77
48 list [set $x] $i
49 } {77 77}
51 test set-1.8 {TclCompileSetCmd: non-simple (computed) variable name} {
52 set x "i"
53 set i 77
54 list [set [set x] 2] $i
55 } {2 2}
57 test set-1.9 {TclCompileSetCmd: 3rd arg => assignment} {
58 set i "abcdef"
59 list [set i] $i
60 } {abcdef abcdef}
62 test set-1.10 {TclCompileSetCmd: only two args => just getting value} {
63 set i {one two}
64 set i
65 } {one two}
67 test set-1.11 {TclCompileSetCmd: simple global name} {
68 proc p {} {
69 global i
70 set i 54
71 set i
74 } {54}
76 test set-1.12 {TclCompileSetCmd: simple local name} {
77 proc p {bar} {
78 set foo $bar
79 set foo
81 p 999
82 } {999}
84 test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} {
85 proc 260locals {} {
86 # create 260 locals (the last ones with index > 255)
87 set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
88 set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
89 set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
90 set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
91 set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
92 set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
93 set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
94 set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
95 set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
96 set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
97 set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
98 set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
99 set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
100 set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
101 set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
102 set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
103 set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
104 set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
105 set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
106 set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
107 set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
108 set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
109 set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
110 set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
111 set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
112 set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
113 set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
114 set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
115 set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
116 set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
117 set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
118 set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
119 set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
120 set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
121 set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
122 set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
123 set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
124 set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
125 set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
126 set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
127 set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
128 set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
129 set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
130 set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
131 set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
132 set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
133 set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
134 set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
135 set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
136 set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
137 set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
138 set z5 0; set z6 0; set z7 0; set z8 0; set z9 1234
140 260locals
141 } {1234}
143 test set-1.17 {TclCompileSetCmd: doing assignment, simple int} {
144 set i 5
145 set i 123
146 } 123
148 test set-1.18 {TclCompileSetCmd: doing assignment, simple int} {
149 set i 5
150 set i -100
151 } -100
153 test set-1.19 {TclCompileSetCmd: doing assignment, simple but not int} {
154 set i 5
155 set i 0x12MNOP
156 set i
157 } {0x12MNOP}
159 test set-1.20 {TclCompileSetCmd: doing assignment, in quotes} {
160 set i 25
161 set i "-100"
162 } -100
164 test set-1.21 {TclCompileSetCmd: doing assignment, in braces} {
165 set i 24
166 set i {126}
167 } 126
169 test set-1.22 {TclCompileSetCmd: doing assignment, large int} {
170 set i 5
171 set i 200000
172 } 200000
174 test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} {
175 set i 25
176 set i 000012345 ;# an octal literal == 5349 decimal
177 list $i [incr i]
178 } {000012345 5350}
180 ################################################################################
181 # LIST
182 ################################################################################
184 test list-1.1 {basic tests} {list a b c} {a b c}
185 test list-1.2 {basic tests} {list {a b} c} {{a b} c}
186 test list-1.3 {basic tests} {list \{a b c} {\{a b c}
187 test list-1.4 {basic tests} "list a{}} b{} c}" "a\\{\\}\\} b{} c\\}"
188 test list-1.5 {basic tests} {list a\[ b\] } "{a\[} b\\]"
189 test list-1.6 {basic tests} {list c\ d\t } "{c } {d\t}"
190 test list-1.7 {basic tests} {list e\n f\$ } "{e\n} {f\$}"
191 test list-1.8 {basic tests} {list g\; h\\} {{g;} h\\}
192 test list-1.9 {basic tests} "list a\\\[} b\\\]} " "a\\\[\\\} b\\\]\\\}"
193 test list-1.10 {basic tests} "list c\\\} d\\t} " "c\\} d\\t\\}"
194 test list-1.11 {basic tests} "list e\\n} f\\$} " "e\\n\\} f\\$\\}"
195 test list-1.12 {basic tests} "list g\\;} h\\\\} " "g\\;\\} {h\\}}"
196 test list-1.13 {basic tests} {list a {{}} b} {a {{}} b}
197 test list-1.14 {basic tests} {list a b xy\\} "a b xy\\\\"
198 test list-1.15 {basic tests} "list a b\} e\\" "a b\\} e\\\\"
199 test list-1.16 {basic tests} "list a b\}\\\$ e\\\$\\" "a b\\}\\\$ e\\\$\\\\"
200 test list-1.17 {basic tests} {list a\f \{\f} "{a\f} \\\{\\f"
201 test list-1.18 {basic tests} {list a\r \{\r} "{a\r} \\\{\\r"
202 test list-1.19 {basic tests} {list a\v \{\v} "{a\v} \\\{\\v"
203 test list-1.20 {basic tests} {list \"\}\{} "\\\"\\}\\{"
204 test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd"
205 test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\
206 test list-1.23 {basic tests} {list \{} "\\{"
207 test list-1.24 {basic tests} {list} {}
209 set num 0
210 proc lcheck {testid a b c} {
211 global num d
212 set d [list $a $b $c]
213 test ${testid}-0 {what goes in must come out} {lindex $d 0} $a
214 test ${testid}-1 {what goes in must come out} {lindex $d 1} $b
215 test ${testid}-2 {what goes in must come out} {lindex $d 2} $c
217 lcheck list-2.1 a b c
218 lcheck list-2.2 "a b" c\td e\nf
219 lcheck list-2.3 {{a b}} {} { }
220 lcheck list-2.4 \$ \$ab ab\$
221 lcheck list-2.5 \; \;ab ab\;
222 lcheck list-2.6 \[ \[ab ab\[
223 lcheck list-2.7 \\ \\ab ab\\
224 lcheck list-2.8 {"} {"ab} {ab"} ;#" Stupid emacs highlighting!
225 lcheck list-2.9 {a b} { ab} {ab }
226 lcheck list-2.10 a{ a{b \{ab
227 lcheck list-2.11 a} a}b }ab
228 lcheck list-2.12 a\\} {a \}b} {a \{c}
229 lcheck list-2.13 xyz \\ 1\\\n2
230 lcheck list-2.14 "{ab}\\" "{ab}xy" abc
232 concat {}
234 ################################################################################
235 # WHILE
236 ################################################################################
238 test while-1.9 {TclCompileWhileCmd: simple command body} {
239 set a {}
240 set i 1
241 while {$i<6} {
242 if $i==4 break
243 set a [concat $a $i]
244 incr i
246 set a
247 } {1 2 3}
249 test while-1.10 {TclCompileWhileCmd: command body in quotes} {
250 set a {}
251 set i 1
252 while {$i<6} "append a x; incr i"
253 set a
254 } {xxxxx}
256 test while-1.13 {TclCompileWhileCmd: while command result} {
257 set i 0
258 set a [while {$i < 5} {incr i}]
259 set a
260 } {}
262 test while-1.14 {TclCompileWhileCmd: while command result} {
263 set i 0
264 set a [while {$i < 5} {if $i==3 break; incr i}]
265 set a
266 } {}
268 test while-2.1 {continue tests} {
269 set a {}
270 set i 1
271 while {$i <= 4} {
272 incr i
273 if {$i == 3} continue
274 set a [concat $a $i]
276 set a
277 } {2 4 5}
278 test while-2.2 {continue tests} {
279 set a {}
280 set i 1
281 while {$i <= 4} {
282 incr i
283 if {$i != 2} continue
284 set a [concat $a $i]
286 set a
287 } {2}
288 test while-2.3 {continue tests, nested loops} {
289 set msg {}
290 set i 1
291 while {$i <= 4} {
292 incr i
293 set a 1
294 while {$a <= 2} {
295 incr a
296 if {$i>=3 && $a>=3} continue
297 set msg [concat $msg "$i.$a"]
300 set msg
301 } {2.2 2.3 3.2 4.2 5.2}
303 test while-4.1 {while and computed command names} {
304 set i 0
305 set z while
306 $z {$i < 10} {
307 incr i
309 set i
310 } 10
312 test while-5.2 {break tests with computed command names} {
313 set a {}
314 set i 1
315 set z break
316 while {$i <= 4} {
317 if {$i == 3} $z
318 set a [concat $a $i]
319 incr i
321 set a
322 } {1 2}
324 test while-7.1 {delayed substitution of body} {
325 set i 0
326 while {[incr i] < 10} "
327 set result $i
329 proc p {} {
330 set i 0
331 while {[incr i] < 10} "
332 set result $i
334 set result
336 append result [p]
337 } {00}
339 ################################################################################
340 # LSET
341 ################################################################################
343 set lset lset
345 test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} {
346 set x {0 1 2}
347 list [eval [list $lset x 0 3]] $x
348 } {{3 1 2} {3 1 2}}
350 test lset-3.1 {lset, not compiled, 3 args, data duplicated} {
351 set x {0 1 2}
352 list [eval [list $lset x 0 $x]] $x
353 } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
355 test lset-3.2 {lset, not compiled, 3 args, data duplicated} {
356 set x {0 1}
357 set y $x
358 list [eval [list $lset x 0 2]] $x $y
359 } {{2 1} {2 1} {0 1}}
361 test lset-3.3 {lset, not compiled, 3 args, data duplicated} {
362 set x {0 1}
363 set y $x
364 list [eval [list $lset x 0 $x]] $x $y
365 } {{{0 1} 1} {{0 1} 1} {0 1}}
367 test lset-3.4 {lset, not compiled, 3 args, data duplicated} {
368 set x {0 1 2}
369 list [eval [list $lset x [list 0] $x]] $x
370 } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
372 test lset-3.5 {lset, not compiled, 3 args, data duplicated} {
373 set x {0 1}
374 set y $x
375 list [eval [list $lset x [list 0] 2]] $x $y
376 } {{2 1} {2 1} {0 1}}
378 test lset-3.6 {lset, not compiled, 3 args, data duplicated} {
379 set x {0 1}
380 set y $x
381 list [eval [list $lset x [list 0] $x]] $x $y
382 } {{{0 1} 1} {{0 1} 1} {0 1}}
384 test lset-4.2 {lset, not compiled, 3 args, bad index} {
385 set a {x y z}
386 list [catch {
387 eval [list $lset a [list 2a2] w]
388 } msg] $msg
389 } {1 {bad index "2a2": must be integer or end?-integer?}}
391 test lset-4.3 {lset, not compiled, 3 args, index out of range} {
392 set a {x y z}
393 list [catch {
394 eval [list $lset a [list -1] w]
395 } msg] $msg
396 } {1 {list index out of range}}
398 test lset-4.4 {lset, not compiled, 3 args, index out of range} {
399 set a {x y z}
400 list [catch {
401 eval [list $lset a [list 3] w]
402 } msg] $msg
403 } {1 {list index out of range}}
405 test lset-4.5 {lset, not compiled, 3 args, index out of range} {
406 set a {x y z}
407 list [catch {
408 eval [list $lset a [list end--1] w]
409 } msg] $msg
410 } {1 {list index out of range}}
412 test lset-4.6 {lset, not compiled, 3 args, index out of range} {
413 set a {x y z}
414 list [catch {
415 eval [list $lset a [list end-3] w]
416 } msg] $msg
417 } {1 {list index out of range}}
419 test lset-4.8 {lset, not compiled, 3 args, bad index} {
420 set a {x y z}
421 list [catch {
422 eval [list $lset a 2a2 w]
423 } msg] $msg
424 } {1 {bad index "2a2": must be integer or end?-integer?}}
426 test lset-4.9 {lset, not compiled, 3 args, index out of range} {
427 set a {x y z}
428 list [catch {
429 eval [list $lset a -1 w]
430 } msg] $msg
431 } {1 {list index out of range}}
433 test lset-4.10 {lset, not compiled, 3 args, index out of range} {
434 set a {x y z}
435 list [catch {
436 eval [list $lset a 3 w]
437 } msg] $msg
438 } {1 {list index out of range}}
440 test lset-4.11 {lset, not compiled, 3 args, index out of range} {
441 set a {x y z}
442 list [catch {
443 eval [list $lset a end--1 w]
444 } msg] $msg
445 } {1 {list index out of range}}
447 test lset-4.12 {lset, not compiled, 3 args, index out of range} {
448 set a {x y z}
449 list [catch {
450 eval [list $lset a end-3 w]
451 } msg] $msg
452 } {1 {list index out of range}}
454 test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} {
455 set a {x y z}
456 list [eval [list $lset a 0 a]] $a
457 } {{a y z} {a y z}}
459 test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} {
460 set a {x y z}
461 list [eval [list $lset a [list 0] a]] $a
462 } {{a y z} {a y z}}
464 test lset-6.3 {lset, not compiled, 1-d list basics} {
465 set a {x y z}
466 list [eval [list $lset a 2 a]] $a
467 } {{x y a} {x y a}}
469 test lset-6.4 {lset, not compiled, 1-d list basics} {
470 set a {x y z}
471 list [eval [list $lset a [list 2] a]] $a
472 } {{x y a} {x y a}}
474 test lset-6.5 {lset, not compiled, 1-d list basics} {
475 set a {x y z}
476 list [eval [list $lset a end a]] $a
477 } {{x y a} {x y a}}
479 test lset-6.6 {lset, not compiled, 1-d list basics} {
480 set a {x y z}
481 list [eval [list $lset a [list end] a]] $a
482 } {{x y a} {x y a}}
484 test lset-6.7 {lset, not compiled, 1-d list basics} {
485 set a {x y z}
486 list [eval [list $lset a end-0 a]] $a
487 } {{x y a} {x y a}}
489 test lset-6.8 {lset, not compiled, 1-d list basics} {
490 set a {x y z}
491 list [eval [list $lset a [list end-0] a]] $a
492 } {{x y a} {x y a}}
493 test lset-6.9 {lset, not compiled, 1-d list basics} {
494 set a {x y z}
495 list [eval [list $lset a end-2 a]] $a
496 } {{a y z} {a y z}}
498 test lset-6.10 {lset, not compiled, 1-d list basics} {
499 set a {x y z}
500 list [eval [list $lset a [list end-2] a]] $a
501 } {{a y z} {a y z}}
503 test lset-7.1 {lset, not compiled, data sharing} {
504 set a 0
505 list [eval [list $lset a $a {gag me}]] $a
506 } {{{gag me}} {{gag me}}}
508 test lset-7.2 {lset, not compiled, data sharing} {
509 set a [list 0]
510 list [eval [list $lset a $a {gag me}]] $a
511 } {{{gag me}} {{gag me}}}
513 test lset-7.3 {lset, not compiled, data sharing} {
514 set a {x y}
515 list [eval [list $lset a 0 $a]] $a
516 } {{{x y} y} {{x y} y}}
518 test lset-7.4 {lset, not compiled, data sharing} {
519 set a {x y}
520 list [eval [list $lset a [list 0] $a]] $a
521 } {{{x y} y} {{x y} y}}
523 test lset-7.5 {lset, not compiled, data sharing} {
524 set n 0
525 set a {x y}
526 list [eval [list $lset a $n $n]] $a $n
527 } {{0 y} {0 y} 0}
529 test lset-7.6 {lset, not compiled, data sharing} {
530 set n [list 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.7 {lset, not compiled, data sharing} {
536 set n 0
537 set a [list $n $n]
538 list [eval [list $lset a $n 1]] $a $n
539 } {{1 0} {1 0} 0}
541 test lset-7.8 {lset, not compiled, data sharing} {
542 set n [list 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.9 {lset, not compiled, data sharing} {
548 set a 0
549 list [eval [list $lset a $a $a]] $a
550 } {0 0}
552 test lset-7.10 {lset, not compiled, data sharing} {
553 set a [list 0]
554 list [eval [list $lset a $a $a]] $a
555 } {0 0}
557 test lset-8.3 {lset, not compiled, bad second index} {
558 set a {{b c} {d e}}
559 list [catch {eval [list $lset a 0 2a2 f]} msg] $msg
560 } {1 {bad index "2a2": must be integer or end?-integer?}}
562 test lset-8.5 {lset, not compiled, second index out of range} {
563 set a {{b c} {d e} {f g}}
564 list [catch {eval [list $lset a 2 -1 h]} msg] $msg
565 } {1 {list index out of range}}
567 test lset-8.7 {lset, not compiled, second index out of range} {
568 set a {{b c} {d e} {f g}}
569 list [catch {eval [list $lset a 2 2 h]} msg] $msg
570 } {1 {list index out of range}}
572 test lset-8.9 {lset, not compiled, second index out of range} {
573 set a {{b c} {d e} {f g}}
574 list [catch {eval [list $lset a 2 end--1 h]} msg] $msg
575 } {1 {list index out of range}}
577 test lset-8.11 {lset, not compiled, second index out of range} {
578 set a {{b c} {d e} {f g}}
579 list [catch {eval [list $lset a 2 end-2 h]} msg] $msg
580 } {1 {list index out of range}}
582 test lset-9.1 {lset, not compiled, entire variable} {
583 set a x
584 list [eval [list $lset a y]] $a
585 } {y y}
587 test lset-10.1 {lset, not compiled, shared data} {
588 set row {p q}
589 set a [list $row $row]
590 list [eval [list $lset a 0 0 x]] $a
591 } {{{x q} {p q}} {{x q} {p q}}}
593 test lset-11.1 {lset, not compiled, 2-d basics} {
594 set a {{b c} {d e}}
595 list [eval [list $lset a 0 0 f]] $a
596 } {{{f c} {d e}} {{f c} {d e}}}
598 test lset-11.3 {lset, not compiled, 2-d basics} {
599 set a {{b c} {d e}}
600 list [eval [list $lset a 0 1 f]] $a
601 } {{{b f} {d e}} {{b f} {d e}}}
603 test lset-11.5 {lset, not compiled, 2-d basics} {
604 set a {{b c} {d e}}
605 list [eval [list $lset a 1 0 f]] $a
606 } {{{b c} {f e}} {{b c} {f e}}}
608 test lset-11.7 {lset, not compiled, 2-d basics} {
609 set a {{b c} {d e}}
610 list [eval [list $lset a 1 1 f]] $a
611 } {{{b c} {d f}} {{b c} {d f}}}
613 test lset-12.0 {lset, not compiled, typical sharing pattern} {
614 set zero 0
615 set row [list $zero $zero $zero $zero]
616 set ident [list $row $row $row $row]
617 for { set i 0 } { $i < 4 } { incr i } {
618 eval [list $lset ident $i $i 1]
620 set ident
621 } {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}}
623 test lset-13.0 {lset, not compiled, shimmering hell} {
624 set a 0
625 list [eval [list $lset a $a $a $a $a {gag me}]] $a
626 } {{{{{{gag me}}}}} {{{{{gag me}}}}}}
628 test lset-13.1 {lset, not compiled, shimmering hell} {
629 set a [list 0]
630 list [eval [list $lset a $a $a $a $a {gag me}]] $a
631 } {{{{{{gag me}}}}} {{{{{gag me}}}}}}
633 test lset-14.1 {lset, not compiled, list args, is string rep preserved?} {
634 set a { { 1 2 } { 3 4 } }
635 catch { eval [list $lset a {1 5} 5] }
636 list $a [lindex $a 1]
637 } "{ { 1 2 } { 3 4 } } { 3 4 }"
639 catch {unset noRead}
640 catch {unset noWrite}
641 catch {rename failTrace {}}
642 catch {unset ::x}
643 catch {unset ::y}
645 ################################################################################
646 # IF
647 ################################################################################
649 test if-1.1 {bad syntax: lacking all} {
650 catch {if}
652 test if-1.2 {bad syntax: lacking then-clause} {
653 catch {if 1==1}
655 test if-1.3 {bad syntax: lacking then-clause 2} {
656 catch {if 1==1 then}
658 test if-1.4 {bad syntax: lacking else-clause after keyword 'else'} {
659 catch {if 1==0 then {list 1} else}
661 test if-1.5 {bad syntax: lacking expr after 'elseif'} {
662 catch {if 1==0 then {list 1} elseif}
664 test if-1.6 {bad syntax: lacking then-clause after 'elseif'} {
665 catch {if 1==0 then {list 1} elseif 1==1}
667 test if-1.7 {bad syntax: lacking else-clause after 'elseif' after keyword 'else'} {
668 catch {if 1==0 then {list 1} elseif 1==0 {list 2} else}
670 test if-1.8 {bad syntax: extra arg after implicit else-clause} {
671 catch {if 1==0 {list 1} elseif 1==0 then {list 2} {list 3} else}
673 test if-1.9 {bad syntax: elsif-clause after else-clause} {
674 catch {if 1==0 {list 1} else {list 2} elseif 1==1 {list 3}}
676 test if-2.1 {taking proper branch} {
677 set a {}
678 if 0 {set a 1} else {set a 2}
679 set a
681 test if-2.2 {taking proper branch} {
682 set a {}
683 if 1 {set a 1} else {set a 2}
684 set a
686 test if-2.3 {taking proper branch} {
687 set a {}
688 if 1<2 {set a 1}
689 set a
691 test if-2.4 {taking proper branch} {
692 set a {}
693 if 1>2 {set a 1}
694 set a
695 } {}
696 test if-2.5 {taking proper branch} {
697 set a {}
698 if 0 {set a 1} else {}
699 set a
700 } {}
701 test if-2.6 {taking proper branch} {
702 set a {}
703 if 0 {set a 1} elseif 1 {set a 2} elseif 1 {set a 3} else {set a 4}
704 set a
706 test if-2.7 {taking proper branch} {
707 set a {}
708 if 0 {set a 1} elseif 0 {set a 2} elseif 1 {set a 3} else {set a 4}
709 set a
711 test if-2.8 {taking proper branch} {
712 set a {}
713 if 0 {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} else {set a 4}
714 set a
716 test if-2.9 {taking proper branch, multiline test expr} {
717 set a {}
718 if {1 != \
719 3} {set a 3} else {set a 4}
720 set a
722 test if-3.1 {optional then-else args} {
723 set a 44
724 if 0 then {set a 1} elseif 0 then {set a 3} else {set a 2}
725 set a
727 test if-3.2 {optional then-else args} {
728 set a 44
729 if 1 then {set a 1} else {set a 2}
730 set a
732 test if-3.3 {optional then-else args} {
733 set a 44
734 if 0 {set a 1} else {set a 2}
735 set a
737 test if-3.4 {optional then-else args} {
738 set a 44
739 if 1 {set a 1} else {set a 2}
740 set a
742 test if-3.5 {optional then-else args} {
743 set a 44
744 if 0 then {set a 1} {set a 2}
745 set a
747 test if-3.6 {optional then-else args} {
748 set a 44
749 if 1 then {set a 1} {set a 2}
750 set a
752 test if-3.7 {optional then-else args} {
753 set a 44
754 if 0 then {set a 1} else {set a 2}
755 set a
757 test if-3.8 {optional then-else args} {
758 set a 44
759 if 0 then {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} {set a 4}
760 set a
762 test if-4.1 {return value} {
763 if 1 then {set a 22; concat abc}
764 } abc
765 test if-4.2 {return value} {
766 if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
767 } def
768 test if-4.3 {return value} {
769 if 0 then {set a 22; concat abc} else {concat def}
770 } def
771 test if-4.4 {return value} {
772 if 0 then {set a 22; concat abc}
773 } {}
774 test if-4.5 {return value} {
775 if 0 then {set a 22; concat abc} elseif 0 {concat def}
776 } {}
777 test if-5.1 {error conditions} {
778 list [catch {if {[error "error in condition"]} foo} msg] $msg
779 } {1 {error in condition}}
780 test if-5.2 {error conditions} {
781 list [catch {if 2 the} msg] $msg
782 } {1 {invalid command name "the"}}
783 test if-5.3 {error conditions} {
784 list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
785 } {1 {error in then clause}}
786 test if-5.4 {error conditions} {
787 list [catch {if 0 then foo elsei} msg] $msg
788 } {1 {invalid command name "elsei"}}
789 test if-5.5 {error conditions} {
790 list [catch {if 0 then foo elseif 0 bar els} msg] $msg
791 } {1 {invalid command name "els"}}
792 test if-5.6 {error conditions} {
793 list [catch {if 0 then foo elseif 0 bar else {[error "error in else clause"]}} msg] $msg
794 } {1 {error in else clause}}
796 ################################################################################
797 # APPEND
798 ################################################################################
800 catch {unset x}
802 test append-1.1 {append command} {
803 catch {unset x}
804 list [append x 1 2 abc "long string"] $x
805 } {{12abclong string} {12abclong string}}
806 test append-1.2 {append command} {
807 set x ""
808 list [append x first] [append x second] [append x third] $x
809 } {first firstsecond firstsecondthird firstsecondthird}
810 test append-1.3 {append command} {
811 set x "abcd"
812 append x
813 } abcd
815 test append-2.1 {long appends} {
816 set x ""
817 for {set i 0} {$i < 1000} {set i [expr $i+1]} {
818 append x "foobar "
820 set y "foobar"
821 set y "$y $y $y $y $y $y $y $y $y $y"
822 set y "$y $y $y $y $y $y $y $y $y $y"
823 set y "$y $y $y $y $y $y $y $y $y $y "
824 expr {$x eq $y}
827 test append-3.1 {append errors} {
828 list [catch {append} msg] $msg
829 } {1 {wrong # args: should be "append varName ?value value ...?"}}
830 #test append-3.2 {append errors} {
831 # set x ""
832 # list [catch {append x(0) 44} msg] $msg
833 #} {1 {can't set "x(0)": variable isn't array}}
834 test append-3.3 {append errors} {
835 catch {unset x}
836 list [catch {append x} msg] $msg
837 } {1 {can't read "x": no such variable}}
839 test append-4.1 {lappend command} {
840 catch {unset x}
841 list [lappend x 1 2 abc "long string"] $x
842 } {{1 2 abc {long string}} {1 2 abc {long string}}}
843 test append-4.2 {lappend command} {
844 set x ""
845 list [lappend x first] [lappend x second] [lappend x third] $x
846 } {first {first second} {first second third} {first second third}}
847 test append-4.3 {lappend command} {
848 proc foo {} {
849 global x
850 set x old
851 unset x
852 lappend x new
854 set result [foo]
855 rename foo {}
856 set result
857 } {new}
858 test append-4.4 {lappend command} {
859 set x {}
860 lappend x \{\ abc
861 } {\{\ abc}
862 test append-4.5 {lappend command} {
863 set x {}
864 lappend x \{ abc
865 } {\{ abc}
866 test append-4.6 {lappend command} {
867 set x {1 2 3}
868 lappend x
869 } {1 2 3}
870 test append-4.7 {lappend command} {
871 set x "a\{"
872 lappend x abc
873 } "a\\\{ abc"
874 test append-4.8 {lappend command} {
875 set x "\\\{"
876 lappend x abc
877 } "\\{ abc"
878 #test append-4.9 {lappend command} {
879 # set x " \{"
880 # list [catch {lappend x abc} msg] $msg
881 #} {1 {unmatched open brace in list}}
882 #test append-4.10 {lappend command} {
883 # set x " \{"
884 # list [catch {lappend x abc} msg] $msg
885 #} {1 {unmatched open brace in list}}
886 #test append-4.11 {lappend command} {
887 # set x "\{\{\{"
888 # list [catch {lappend x abc} msg] $msg
889 #} {1 {unmatched open brace in list}}
890 #test append-4.12 {lappend command} {
891 # set x "x \{\{\{"
892 # list [catch {lappend x abc} msg] $msg
893 #} {1 {unmatched open brace in list}}
894 test append-4.13 {lappend command} {
895 set x "x\{\{\{"
896 lappend x abc
897 } "x\\\{\\\{\\\{ abc"
898 test append-4.14 {lappend command} {
899 set x " "
900 lappend x abc
901 } "abc"
902 test append-4.15 {lappend command} {
903 set x "\\ "
904 lappend x abc
905 } "{ } abc"
906 test append-4.16 {lappend command} {
907 set x "x "
908 lappend x abc
909 } "x abc"
910 test append-4.17 {lappend command} {
911 catch {unset x}
912 lappend x
913 } {}
914 test append-4.18 {lappend command} {
915 catch {unset x}
916 lappend x {}
917 } {{}}
918 test append-4.19 {lappend command} {
919 catch {unset x}
920 lappend x(0)
921 } {}
922 test append-4.20 {lappend command} {
923 catch {unset x}
924 lappend x(0) abc
925 } {abc}
927 proc check {var size} {
928 set l [llength $var]
929 if {$l != $size} {
930 return "length mismatch: should have been $size, was $l"
932 for {set i 0} {$i < $size} {set i [expr $i+1]} {
933 set j [lindex $var $i]
934 if {$j ne "item $i"} {
935 return "element $i should have been \"item $i\", was \"$j\""
938 return ok
940 test append-5.1 {long lappends} {
941 catch {unset x}
942 set x ""
943 for {set i 0} {$i < 300} {set i [expr $i+1]} {
944 lappend x "item $i"
946 check $x 300
947 } ok
949 test append-6.1 {lappend errors} {
950 list [catch {lappend} msg] $msg
951 } {1 {wrong # args: should be "lappend varName ?value value ...?"}}
952 #test append-6.2 {lappend errors} {
953 # set x ""
954 # list [catch {lappend x(0) 44} msg] $msg
955 #} {1 {can't set "x(0)": variable isn't array}}
957 ################################################################################
958 # UPLEVEL
959 ################################################################################
961 proc a {x y} {
962 newset z [expr $x+$y]
963 return $z
965 proc newset {name value} {
966 uplevel set $name $value
967 uplevel 1 {uplevel 1 {set xyz 22}}
970 test uplevel-1.1 {simple operation} {
971 set xyz 0
972 a 22 33
973 } 55
974 test uplevel-1.2 {command is another uplevel command} {
975 set xyz 0
976 a 22 33
977 set xyz
978 } 22
980 proc a1 {} {
982 global a a1
983 set a $x
984 set a1 $y
986 proc b1 {} {
988 global b b1
989 set b $x
990 set b1 $y
992 proc c1 {} {
993 uplevel 1 set x 111
994 uplevel #2 set y 222
995 uplevel 2 set x 333
996 uplevel #1 set y 444
997 uplevel 3 set x 555
998 uplevel #0 set y 666
1001 test uplevel-2.1 {relative and absolute uplevel} {set a} 333
1002 test uplevel-2.2 {relative and absolute uplevel} {set a1} 444
1003 test uplevel-2.3 {relative and absolute uplevel} {set b} 111
1004 test uplevel-2.4 {relative and absolute uplevel} {set b1} 222
1005 test uplevel-2.5 {relative and absolute uplevel} {set x} 555
1006 test uplevel-2.6 {relative and absolute uplevel} {set y} 666
1008 test uplevel-3.1 {uplevel to same level} {
1009 set x 33
1010 uplevel #0 set x 44
1011 set x
1012 } 44
1013 test uplevel-3.2 {uplevel to same level} {
1014 set x 33
1015 uplevel 0 set x
1016 } 33
1017 test uplevel-3.3 {uplevel to same level} {
1018 set y xxx
1019 proc a1 {} {set y 55; uplevel 0 set y 66; return $y}
1021 } 66
1022 test uplevel-3.4 {uplevel to same level} {
1023 set y zzz
1024 proc a1 {} {set y 55; uplevel #1 set y}
1026 } 55
1028 test uplevel-4.1 {error: non-existent level} {
1029 list [catch c1 msg] $msg
1030 } {1 {bad level "#2"}}
1031 test uplevel-4.2 {error: non-existent level} {
1032 proc c2 {} {uplevel 3 {set a b}}
1033 list [catch c2 msg] $msg
1034 } {1 {bad level "3"}}
1035 test uplevel-4.3 {error: not enough args} {
1036 list [catch uplevel msg] $msg
1037 } {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
1038 test uplevel-4.4 {error: not enough args} {
1039 proc upBug {} {uplevel 1}
1040 list [catch upBug msg] $msg
1041 } {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
1043 proc a2 {} {
1044 uplevel a3
1046 proc a3 {} {
1047 global x y
1048 set x [info level]
1049 set y [info level 1]
1052 test uplevel-5.1 {info level} {set x} 1
1053 test uplevel-5.2 {info level} {set y} a3
1055 ################################################################################
1056 # UNKNOWN
1057 ################################################################################
1059 catch {unset x}
1060 catch {rename unknown unknown.old}
1062 test unknown-1.1 {non-existent "unknown" command} {
1063 list [catch {_non-existent_ foo bar} msg] $msg
1064 } {1 {invalid command name "_non-existent_"}}
1066 proc unknown {args} {
1067 global x
1068 set x $args
1071 test unknown-2.1 {calling "unknown" command} {
1072 foobar x y z
1073 set x
1074 } {foobar x y z}
1075 test unknown-2.2 {calling "unknown" command with lots of args} {
1076 foobar 1 2 3 4 5 6 7
1077 set x
1078 } {foobar 1 2 3 4 5 6 7}
1079 test unknown-2.3 {calling "unknown" command with lots of args} {
1080 foobar 1 2 3 4 5 6 7 8
1081 set x
1082 } {foobar 1 2 3 4 5 6 7 8}
1083 test unknown-2.4 {calling "unknown" command with lots of args} {
1084 foobar 1 2 3 4 5 6 7 8 9
1085 set x
1086 } {foobar 1 2 3 4 5 6 7 8 9}
1088 test unknown-3.1 {argument quoting in calls to "unknown"} {
1089 foobar \{ \} a\{b \; "\\" \$a a\[b \]
1090 set x
1091 } "foobar \\{ \\} a\\{b {;} \\\\ {\$a} {a\[b} \\]"
1093 proc unknown args {
1094 error "unknown failed"
1097 rename unknown {}
1099 #test unknown-4.1 {errors in "unknown" procedure} {
1100 # list [catch {non-existent a b} msg] $msg $errorCode
1101 #} {1 {unknown failed} NONE}
1103 ################################################################################
1104 # INCR
1105 ################################################################################
1107 catch {unset x}
1108 catch {unset i}
1110 test incr-1.1 {TclCompileIncrCmd: missing variable name} {
1111 list [catch {incr} msg] $msg
1112 } {1 {wrong # args: should be "incr varName ?increment?"}}
1113 test incr-1.2 {TclCompileIncrCmd: simple variable name} {
1114 set i 10
1115 list [incr i] $i
1116 } {11 11}
1117 #test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
1118 # set i 10
1119 # catch {incr "i"xxx} msg
1120 # set msg
1121 #} {extra characters after close-quote}
1122 test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
1123 set i 17
1124 list [incr "i"] $i
1125 } {18 18}
1126 test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} {
1127 catch {unset {a simple var}}
1128 set {a simple var} 27
1129 list [incr {a simple var}] ${a simple var}
1130 } {28 28}
1131 test incr-1.6 {TclCompileIncrCmd: simple array variable name} {
1132 catch {unset a}
1133 set a(foo) 37
1134 list [incr a(foo)] $a(foo)
1135 } {38 38}
1136 test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
1137 set x "i"
1138 set i 77
1139 list [incr $x 2] $i
1140 } {79 79}
1141 test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
1142 set x "i"
1143 set i 77
1144 list [incr [set x] +2] $i
1145 } {79 79}
1147 test incr-1.9 {TclCompileIncrCmd: increment given} {
1148 set i 10
1149 list [incr i +07] $i
1150 } {17 17}
1151 test incr-1.10 {TclCompileIncrCmd: no increment given} {
1152 set i 10
1153 list [incr i] $i
1154 } {11 11}
1156 test incr-1.11 {TclCompileIncrCmd: simple global name} {
1157 proc p {} {
1158 global i
1159 set i 54
1160 incr i
1163 } {55}
1164 test incr-1.12 {TclCompileIncrCmd: simple local name} {
1165 proc p {} {
1166 set foo 100
1167 incr foo
1170 } {101}
1171 test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} {
1172 proc p {} {
1173 incr bar
1175 catch {p} msg
1176 set msg
1177 } {can't read "bar": no such variable}
1178 test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
1179 proc 260locals {} {
1180 # create 260 locals
1181 set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
1182 set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
1183 set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
1184 set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
1185 set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
1186 set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
1187 set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
1188 set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
1189 set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
1190 set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
1191 set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
1192 set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
1193 set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
1194 set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
1195 set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
1196 set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
1197 set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
1198 set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
1199 set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
1200 set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
1201 set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
1202 set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
1203 set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
1204 set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
1205 set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
1206 set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
1207 set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
1208 set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
1209 set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
1210 set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
1211 set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
1212 set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
1213 set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
1214 set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
1215 set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
1216 set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
1217 set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
1218 set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
1219 set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
1220 set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
1221 set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
1222 set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
1223 set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
1224 set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
1225 set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
1226 set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
1227 set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
1228 set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
1229 set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
1230 set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
1231 set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
1232 set z5 0; set z6 0; set z7 0; set z8 0; set z9 0
1233 # now increment the last one (local var index > 255)
1234 incr z9
1236 260locals
1237 } {1}
1238 test incr-1.15 {TclCompileIncrCmd: variable is array} {
1239 catch {unset a}
1240 set a(foo) 27
1241 set x [incr a(foo) 11]
1242 catch {unset a}
1243 set x
1244 } 38
1245 test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} {
1246 catch {unset a}
1247 set i 5
1248 set a(foo5) 27
1249 set x [incr a(foo$i) 11]
1250 catch {unset a}
1251 set x
1252 } 38
1254 test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
1255 set i 5
1256 incr i 123
1257 } 128
1258 test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
1259 set i 5
1260 incr i -100
1261 } -95
1262 #test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} {
1263 # set i 5
1264 # catch {incr i [set]} msg
1265 # set errorInfo
1266 #} {wrong # args: should be "set varName ?newValue?"
1267 # while compiling
1268 #"set"
1269 # while compiling
1270 #"incr i [set]"}
1271 test incr-1.20 {TclCompileIncrCmd: increment given, in quotes} {
1272 set i 25
1273 incr i "-100"
1274 } -75
1275 test incr-1.21 {TclCompileIncrCmd: increment given, in braces} {
1276 set i 24
1277 incr i {126}
1278 } 150
1279 test incr-1.22 {TclCompileIncrCmd: increment given, large int} {
1280 set i 5
1281 incr i 200000
1282 } 200005
1283 test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
1284 set i 25
1285 incr i 000012345 ;# an octal literal
1286 } 5374
1287 test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
1288 set i 25
1289 catch {incr i 1a} msg
1290 set msg
1291 } {expected integer but got "1a"}
1293 test incr-1.25 {TclCompileIncrCmd: too many arguments} {
1294 set i 10
1295 catch {incr i 10 20} msg
1296 set msg
1297 } {wrong # args: should be "incr varName ?increment?"}
1300 test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
1301 set x " - "
1302 list [catch {incr x 1} msg] $msg
1303 } {1 {expected integer but got " - "}}
1305 test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} {
1306 catch {unset array}
1307 set array(\$foo) 4
1308 incr {array($foo)}
1311 # Check "incr" and computed command names.
1313 test incr-2.0 {incr and computed command names} {
1314 set i 5
1315 set z incr
1316 $z i -1
1317 set i
1319 catch {unset x}
1320 catch {unset i}
1322 test incr-2.1 {incr command (not compiled): missing variable name} {
1323 set z incr
1324 list [catch {$z} msg] $msg
1325 } {1 {wrong # args: should be "incr varName ?increment?"}}
1326 test incr-2.2 {incr command (not compiled): simple variable name} {
1327 set z incr
1328 set i 10
1329 list [$z i] $i
1330 } {11 11}
1331 test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
1332 set z incr
1333 set i 17
1334 list [$z "i"] $i
1335 } {18 18}
1336 test incr-2.5 {incr command (not compiled): simple variable name in braces} {
1337 set z incr
1338 catch {unset {a simple var}}
1339 set {a simple var} 27
1340 list [$z {a simple var}] ${a simple var}
1341 } {28 28}
1342 test incr-2.6 {incr command (not compiled): simple array variable name} {
1343 set z incr
1344 catch {unset a}
1345 set a(foo) 37
1346 list [$z a(foo)] $a(foo)
1347 } {38 38}
1348 test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
1349 set z incr
1350 set x "i"
1351 set i 77
1352 list [$z $x 2] $i
1353 } {79 79}
1354 test incr-2.8 {incr command (not compiled): non-simple (computed) variable name} {
1355 set z incr
1356 set x "i"
1357 set i 77
1358 list [$z [set x] +2] $i
1359 } {79 79}
1361 test incr-2.9 {incr command (not compiled): increment given} {
1362 set z incr
1363 set i 10
1364 list [$z i +07] $i
1365 } {17 17}
1366 test incr-2.10 {incr command (not compiled): no increment given} {
1367 set z incr
1368 set i 10
1369 list [$z i] $i
1370 } {11 11}
1372 test incr-2.11 {incr command (not compiled): simple global name} {
1373 proc p {} {
1374 set z incr
1375 global i
1376 set i 54
1377 $z i
1380 } {55}
1381 test incr-2.12 {incr command (not compiled): simple local name} {
1382 proc p {} {
1383 set z incr
1384 set foo 100
1385 $z foo
1388 } {101}
1389 test incr-2.13 {incr command (not compiled): simple but new (unknown) local name} {
1390 proc p {} {
1391 set z incr
1392 $z bar
1394 catch {p} msg
1395 set msg
1396 } {can't read "bar": no such variable}
1397 test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
1398 proc 260locals {} {
1399 set z incr
1400 # create 260 locals
1401 set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
1402 set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
1403 set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
1404 set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
1405 set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
1406 set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
1407 set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
1408 set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
1409 set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
1410 set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
1411 set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
1412 set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
1413 set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
1414 set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
1415 set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
1416 set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
1417 set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
1418 set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
1419 set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
1420 set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
1421 set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
1422 set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
1423 set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
1424 set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
1425 set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
1426 set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
1427 set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
1428 set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
1429 set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
1430 set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
1431 set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
1432 set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
1433 set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
1434 set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
1435 set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
1436 set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
1437 set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
1438 set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
1439 set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
1440 set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
1441 set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
1442 set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
1443 set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
1444 set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
1445 set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
1446 set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
1447 set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
1448 set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
1449 set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
1450 set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
1451 set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
1452 set z5 0; set z6 0; set z7 0; set z8 0; set z9 0
1453 # now increment the last one (local var index > 255)
1454 $z z9
1456 260locals
1457 } {1}
1458 test incr-2.15 {incr command (not compiled): variable is array} {
1459 set z incr
1460 catch {unset a}
1461 set a(foo) 27
1462 set x [$z a(foo) 11]
1463 catch {unset a}
1464 set x
1465 } 38
1466 test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} {
1467 set z incr
1468 catch {unset a}
1469 set i 5
1470 set a(foo5) 27
1471 set x [$z a(foo$i) 11]
1472 catch {unset a}
1473 set x
1474 } 38
1476 test incr-2.17 {incr command (not compiled): increment given, simple int} {
1477 set z incr
1478 set i 5
1479 $z i 123
1480 } 128
1481 test incr-2.18 {incr command (not compiled): increment given, simple int} {
1482 set z incr
1483 set i 5
1484 $z i -100
1485 } -95
1486 test incr-2.20 {incr command (not compiled): increment given, in quotes} {
1487 set z incr
1488 set i 25
1489 $z i "-100"
1490 } -75
1491 test incr-2.21 {incr command (not compiled): increment given, in braces} {
1492 set z incr
1493 set i 24
1494 $z i {126}
1495 } 150
1496 test incr-2.22 {incr command (not compiled): increment given, large int} {
1497 set z incr
1498 set i 5
1499 $z i 200000
1500 } 200005
1501 test incr-2.23 {incr command (not compiled): increment given, formatted int != int} {
1502 set z incr
1503 set i 25
1504 $z i 000012345 ;# an octal literal
1505 } 5374
1506 test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
1507 set z incr
1508 set i 25
1509 catch {$z i 1a} msg
1510 set msg
1511 } {expected integer but got "1a"}
1513 test incr-2.25 {incr command (not compiled): too many arguments} {
1514 set z incr
1515 set i 10
1516 catch {$z i 10 20} msg
1517 set msg
1518 } {wrong # args: should be "incr varName ?increment?"}
1520 test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
1521 set z incr
1522 set x " - "
1523 list [catch {$z x 1} msg] $msg
1524 } {1 {expected integer but got " - "}}
1526 ################################################################################
1527 # LLENGTH
1528 ################################################################################
1530 test llength-1.1 {length of list} {
1531 llength {a b c d}
1533 test llength-1.2 {length of list} {
1534 llength {a b c {a b {c d}} d}
1536 test llength-1.3 {length of list} {
1537 llength {}
1540 test llength-2.1 {error conditions} {
1541 list [catch {llength} msg] $msg
1542 } {1 {wrong # args: should be "llength list"}}
1543 test llength-2.2 {error conditions} {
1544 list [catch {llength 123 2} msg] $msg
1545 } {1 {wrong # args: should be "llength list"}}
1547 ################################################################################
1548 # LINDEX
1549 ################################################################################
1551 set lindex lindex
1552 set minus -
1554 # Tests of Tcl_LindexObjCmd, NOT COMPILED
1556 #test lindex-1.1 {wrong # args} {
1557 # list [catch {eval $lindex} result] $result
1558 #} "1 {wrong # args: should be \"lindex list ?index...?\"}"
1560 # Indices that are lists or convertible to lists
1562 #test lindex-2.1 {empty index list} {
1563 # set x {}
1564 # list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1565 #} {{a b c} {a b c}}
1567 test lindex-2.2 {singleton index list} {
1568 set x { 1 }
1569 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1570 } {b b}
1572 test lindex-2.4 {malformed index list} {
1573 set x \{
1574 list [catch { eval [list $lindex {a b c} $x] } result] $result
1575 } {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?}
1577 # Indices that are integers or convertible to integers
1579 test lindex-3.1 {integer -1} {
1580 set x ${minus}1
1581 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1582 } {{} {}}
1584 test lindex-3.2 {integer 0} {
1585 set x [string range 00 0 0]
1586 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1587 } {a a}
1589 test lindex-3.3 {integer 2} {
1590 set x [string range 22 0 0]
1591 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1592 } {c c}
1594 test lindex-3.4 {integer 3} {
1595 set x [string range 33 0 0]
1596 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1597 } {{} {}}
1599 test lindex-3.7 {indexes don't shimmer wide ints} {
1600 set x [expr {(1<<31) - 2}]
1601 list $x [lindex {1 2 3} $x] [incr x] [incr x]
1602 } {2147483646 {} 2147483647 2147483648}
1604 # Indices relative to end
1606 test lindex-4.1 {index = end} {
1607 set x end
1608 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1609 } {c c}
1611 test lindex-4.2 {index = end--1} {
1612 set x end--1
1613 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1614 } {{} {}}
1616 test lindex-4.3 {index = end-0} {
1617 set x end-0
1618 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1619 } {c c}
1621 test lindex-4.4 {index = end-2} {
1622 set x end-2
1623 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1624 } {a a}
1626 test lindex-4.5 {index = end-3} {
1627 set x end-3
1628 list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1629 } {{} {}}
1631 test lindex-4.8 {bad integer, not octal} {
1632 set x end-0a2
1633 list [catch { eval [list $lindex {a b c} $x] } result] $result
1634 } "1 {bad index \"end-0a2\": must be integer or end?-integer?}"
1636 #test lindex-4.9 {incomplete end} {
1637 # set x en
1638 # list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
1639 #} {c c}
1641 test lindex-4.10 {incomplete end-} {
1642 set x end-
1643 list [catch { eval [list $lindex {a b c} $x] } result] $result
1644 } "1 {bad index \"end-\": must be integer or end?-integer?}"
1646 test lindex-5.1 {bad second index} {
1647 list [catch { eval [list $lindex {a b c} 0 0a2] } result] $result
1648 } "1 {bad index \"0a2\": must be integer or end?-integer?}"
1650 test lindex-5.2 {good second index} {
1651 eval [list $lindex {{a b c} {d e f} {g h i}} 1 2]
1654 test lindex-5.3 {three indices} {
1655 eval [list $lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1]
1658 test lindex-7.1 {quoted elements} {
1659 eval [list $lindex {a "b c" d} 1]
1660 } {b c}
1661 test lindex-7.2 {quoted elements} {
1662 eval [list $lindex {"{}" b c} 0]
1663 } {{}}
1664 test lindex-7.3 {quoted elements} {
1665 eval [list $lindex {ab "c d \" x" y} 1]
1666 } {c d " x}
1667 test lindex-7.4 {quoted elements} {
1668 lindex {a b {c d "e} {f g"}} 2
1669 } {c d "e}
1671 test lindex-8.1 {data reuse} {
1672 set x 0
1673 eval [list $lindex $x $x]
1674 } {0}
1676 test lindex-8.2 {data reuse} {
1677 set a 0
1678 eval [list $lindex $a $a $a]
1680 test lindex-8.3 {data reuse} {
1681 set a 1
1682 eval [list $lindex $a $a $a]
1683 } {}
1685 #----------------------------------------------------------------------
1687 test lindex-10.2 {singleton index list} {
1688 set x { 1 }
1689 catch {
1690 list [lindex {a b c} $x] [lindex {a b c} $x]
1691 } result
1692 set result
1693 } {b b}
1695 test lindex-10.4 {malformed index list} {
1696 set x \{
1697 list [catch { lindex {a b c} $x } result] $result
1698 } {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?}
1700 # Indices that are integers or convertible to integers
1702 test lindex-11.1 {integer -1} {
1703 set x ${minus}1
1704 catch {
1705 list [lindex {a b c} $x] [lindex {a b c} $x]
1706 } result
1707 set result
1708 } {{} {}}
1710 test lindex-11.2 {integer 0} {
1711 set x [string range 00 0 0]
1712 catch {
1713 list [lindex {a b c} $x] [lindex {a b c} $x]
1714 } result
1715 set result
1716 } {a a}
1718 test lindex-11.3 {integer 2} {
1719 set x [string range 22 0 0]
1720 catch {
1721 list [lindex {a b c} $x] [lindex {a b c} $x]
1722 } result
1723 set result
1724 } {c c}
1726 test lindex-11.4 {integer 3} {
1727 set x [string range 33 0 0]
1728 catch {
1729 list [lindex {a b c} $x] [lindex {a b c} $x]
1730 } result
1731 set result
1732 } {{} {}}
1734 # Indices relative to end
1735 test lindex-12.1 {index = end} {
1736 set x end
1737 catch {
1738 list [lindex {a b c} $x] [lindex {a b c} $x]
1739 } result
1740 set result
1741 } {c c}
1743 test lindex-12.2 {index = end--1} {
1744 set x end--1
1745 catch {
1746 list [lindex {a b c} $x] [lindex {a b c} $x]
1747 } result
1748 set result
1749 } {{} {}}
1751 test lindex-12.3 {index = end-0} {
1752 set x end-0
1753 catch {
1754 list [lindex {a b c} $x] [lindex {a b c} $x]
1755 } result
1756 set result
1757 } {c c}
1759 test lindex-12.4 {index = end-2} {
1760 set x end-2
1761 catch {
1762 list [lindex {a b c} $x] [lindex {a b c} $x]
1763 } result
1764 set result
1765 } {a a}
1767 test lindex-12.5 {index = end-3} {
1768 set x end-3
1769 catch {
1770 list [lindex {a b c} $x] [lindex {a b c} $x]
1771 } result
1772 set result
1773 } {{} {}}
1775 test lindex-12.8 {bad integer, not octal} {
1776 set x end-0a2
1777 list [catch { lindex {a b c} $x } result] $result
1778 } "1 {bad index \"end-0a2\": must be integer or end?-integer?}"
1780 test lindex-12.10 {incomplete end-} {
1781 set x end-
1782 list [catch { lindex {a b c} $x } result] $result
1783 } "1 {bad index \"end-\": must be integer or end?-integer?}"
1785 test lindex-13.1 {bad second index} {
1786 list [catch { lindex {a b c} 0 0a2 } result] $result
1787 } "1 {bad index \"0a2\": must be integer or end?-integer?}"
1789 test lindex-13.2 {good second index} {
1790 catch {
1791 lindex {{a b c} {d e f} {g h i}} 1 2
1792 } result
1793 set result
1796 test lindex-13.3 {three indices} {
1797 catch {
1798 lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1
1799 } result
1800 set result
1803 test lindex-15.1 {quoted elements} {
1804 catch {
1805 lindex {a "b c" d} 1
1806 } result
1807 set result
1808 } {b c}
1809 test lindex-15.2 {quoted elements} {
1810 catch {
1811 lindex {"{}" b c} 0
1812 } result
1813 set result
1814 } {{}}
1815 test lindex-15.3 {quoted elements} {
1816 catch {
1817 lindex {ab "c d \" x" y} 1
1818 } result
1819 set result
1820 } {c d " x}
1821 test lindex-15.4 {quoted elements} {
1822 catch {
1823 lindex {a b {c d "e} {f g"}} 2
1824 } result
1825 set result
1826 } {c d "e}
1828 test lindex-16.1 {data reuse} {
1829 set x 0
1830 catch {
1831 lindex $x $x
1832 } result
1833 set result
1834 } {0}
1836 test lindex-16.2 {data reuse} {
1837 set a 0
1838 catch {
1839 lindex $a $a $a
1840 } result
1841 set result
1843 test lindex-16.3 {data reuse} {
1844 set a 1
1845 catch {
1846 lindex $a $a $a
1847 } result
1848 set result
1849 } {}
1851 catch { unset lindex}
1852 catch { unset minus }
1854 ################################################################################
1855 # LINDEX
1856 ################################################################################
1858 catch {unset a}
1859 catch {unset x}
1861 # Basic "foreach" operation.
1863 test foreach-1.1 {basic foreach tests} {
1864 set a {}
1865 foreach i {a b c d} {
1866 set a [concat $a $i]
1868 set a
1869 } {a b c d}
1870 test foreach-1.2 {basic foreach tests} {
1871 set a {}
1872 foreach i {a b {{c d} e} {123 {{x}}}} {
1873 set a [concat $a $i]
1875 set a
1876 } {a b {c d} e 123 {{x}}}
1877 test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1
1878 test foreach-1.4 {basic foreach tests} {catch {foreach i} msg} 1
1879 test foreach-1.5 {basic foreach tests} {catch {foreach i j} msg} 1
1880 test foreach-1.6 {basic foreach tests} {catch {foreach i j k l} msg} 1
1881 test foreach-1.7 {basic foreach tests} {
1882 set a {}
1883 foreach i {} {
1884 set a [concat $a $i]
1886 set a
1887 } {}
1888 catch {unset a}
1889 test foreach-2.1 {foreach errors} {
1890 list [catch {foreach {} {} {}} msg] $msg
1891 } {1 {foreach varlist is empty}}
1892 catch {unset a}
1894 test foreach-3.1 {parallel foreach tests} {
1895 set x {}
1896 foreach {a b} {1 2 3 4} {
1897 append x $b $a
1899 set x
1900 } {2143}
1901 test foreach-3.2 {parallel foreach tests} {
1902 set x {}
1903 foreach {a b} {1 2 3 4 5} {
1904 append x $b $a
1906 set x
1907 } {21435}
1908 test foreach-3.3 {parallel foreach tests} {
1909 set x {}
1910 foreach a {1 2 3} b {4 5 6} {
1911 append x $b $a
1913 set x
1914 } {415263}
1915 test foreach-3.4 {parallel foreach tests} {
1916 set x {}
1917 foreach a {1 2 3} b {4 5 6 7 8} {
1918 append x $b $a
1920 set x
1921 } {41526378}
1922 test foreach-3.5 {parallel foreach tests} {
1923 set x {}
1924 foreach {a b} {a b A B aa bb} c {c C cc CC} {
1925 append x $a $b $c
1927 set x
1928 } {abcABCaabbccCC}
1929 test foreach-3.6 {parallel foreach tests} {
1930 set x {}
1931 foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
1932 append x $a $b $c $d $e
1934 set x
1935 } {111112222233333}
1936 test foreach-3.7 {parallel foreach tests} {
1937 set x {}
1938 foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
1939 append x $a $b $c $d $e
1941 set x
1942 } {1111 2222334}
1943 test foreach-4.1 {foreach only sets vars if repeating loop} {
1944 proc foo {} {
1945 set rgb {65535 0 0}
1946 foreach {r g b} [set rgb] {}
1947 return "r=$r, g=$g, b=$b"
1950 } {r=65535, g=0, b=0}
1951 test foreach-5.1 {foreach supports dict syntactic sugar} {
1952 proc foo {} {
1953 set x {}
1954 foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]}
1955 list $a $x
1958 } {{3 4} {1 2 3 4}}
1960 test foreach-6.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
1961 catch {unset x}
1962 foreach {12.0} {a b c} {
1963 set x 12.0
1964 set x [expr $x + 1]
1966 set x
1967 } 13.0
1969 # Check "continue".
1971 test foreach-7.1 {continue tests} {catch continue} 4
1972 test foreach-7.2 {continue tests} {
1973 set a {}
1974 foreach i {a b c d} {
1975 if {[string compare $i "b"] == 0} continue
1976 set a [concat $a $i]
1978 set a
1979 } {a c d}
1980 test foreach-7.3 {continue tests} {
1981 set a {}
1982 foreach i {a b c d} {
1983 if {[string compare $i "b"] != 0} continue
1984 set a [concat $a $i]
1986 set a
1987 } {b}
1988 test foreach-7.4 {continue tests} {catch {continue foo} msg} 1
1989 test foreach-7.5 {continue tests} {
1990 catch {continue foo} msg
1991 set msg
1992 } {wrong # args: should be "continue"}
1994 # Check "break".
1996 test foreach-8.1 {break tests} {catch break} 3
1997 test foreach-8.2 {break tests} {
1998 set a {}
1999 foreach i {a b c d} {
2000 if {[string compare $i "c"] == 0} break
2001 set a [concat $a $i]
2003 set a
2004 } {a b}
2005 test foreach-8.3 {break tests} {catch {break foo} msg} 1
2006 test foreach-8.4 {break tests} {
2007 catch {break foo} msg
2008 set msg
2009 } {wrong # args: should be "break"}
2011 # Test for incorrect "double evaluation" semantics
2013 test foreach-9.1 {delayed substitution of body - knownbugs} {
2014 proc foo {} {
2015 set a 0
2016 foreach a [list 1 2 3] "
2017 set x $a
2019 set x
2022 } {0}
2024 # cleanup
2025 catch {unset a}
2026 catch {unset x}
2028 ################################################################################
2029 # STRING
2030 ################################################################################
2032 ## string match
2034 test string-11.1 {string match, too few args} {
2035 proc foo {} {string match a}
2036 list [catch {foo} msg] $msg
2037 } {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
2038 test string-11.2 {string match, too many args} {
2039 proc foo {} {string match a b c d}
2040 list [catch {foo} msg] $msg
2041 } {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
2042 test string-11.3 {string match} {
2043 proc foo {} {string match abc abc}
2046 #test string-11.4 {string match} {
2047 # proc foo {} {string mat abc abd}
2048 # foo
2049 #} 0
2050 test string-11.5 {string match} {
2051 proc foo {} {string match ab*c abc}
2054 test string-11.6 {string match} {
2055 proc foo {} {string match ab**c abc}
2058 test string-11.7 {string match} {
2059 proc foo {} {string match ab* abcdef}
2062 test string-11.8 {string match} {
2063 proc foo {} {string match *c abc}
2066 test string-11.9 {string match} {
2067 proc foo {} {string match *3*6*9 0123456789}
2070 test string-11.10 {string match} {
2071 proc foo {} {string match *3*6*9 01234567890}
2074 test string-11.11 {string match} {
2075 proc foo {} {string match a?c abc}
2078 test string-11.12 {string match} {
2079 proc foo {} {string match a??c abc}
2082 test string-11.13 {string match} {
2083 proc foo {} {string match ?1??4???8? 0123456789}
2086 test string-11.14 {string match} {
2087 proc foo {} {string match {[abc]bc} abc}
2090 test string-11.15 {string match} {
2091 proc foo {} {string match {a[abc]c} abc}
2094 test string-11.16 {string match} {
2095 proc foo {} {string match {a[xyz]c} abc}
2098 test string-11.17 {string match} {
2099 proc foo {} {string match {12[2-7]45} 12345}
2102 test string-11.18 {string match} {
2103 proc foo {} {string match {12[ab2-4cd]45} 12345}
2106 test string-11.19 {string match} {
2107 proc foo {} {string match {12[ab2-4cd]45} 12b45}
2110 test string-11.20 {string match} {
2111 proc foo {} {string match {12[ab2-4cd]45} 12d45}
2114 test string-11.21 {string match} {
2115 proc foo {} {string match {12[ab2-4cd]45} 12145}
2118 test string-11.22 {string match} {
2119 proc foo {} {string match {12[ab2-4cd]45} 12545}
2122 test string-11.23 {string match} {
2123 proc foo {} {string match {a\*b} a*b}
2126 test string-11.24 {string match} {
2127 proc foo {} {string match {a\*b} ab}
2130 test string-11.25 {string match} {
2131 proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
2134 test string-11.26 {string match} {
2135 proc foo {} {string match ** ""}
2138 test string-11.27 {string match} {
2139 proc foo {} {string match *. ""}
2142 test string-11.28 {string match} {
2143 proc foo {} {string match "" ""}
2146 test string-11.29 {string match} {
2147 proc foo {} {string match \[a a}
2150 test string-11.31 {string match case} {
2151 proc foo {} {string match a A}
2154 #test string-11.32 {string match nocase} {
2155 # proc foo {} {string match -n a A}
2156 # foo
2157 #} 1
2158 #test string-11.33 {string match nocase} {
2159 # proc foo {} {string match -nocase a\334 A\374}
2160 # foo
2161 #} 1
2162 test string-11.34 {string match nocase} {
2163 proc foo {} {string match -nocase a*f ABCDEf}
2166 test string-11.35 {string match case, false hope} {
2167 # This is true because '_' lies between the A-Z and a-z ranges
2168 proc foo {} {string match {[A-z]} _}
2171 test string-11.36 {string match nocase range} {
2172 # This is false because although '_' lies between the A-Z and a-z ranges,
2173 # we lower case the end points before checking the ranges.
2174 proc foo {} {string match -nocase {[A-z]} _}
2177 test string-11.37 {string match nocase} {
2178 proc foo {} {string match -nocase {[A-fh-Z]} g}
2181 test string-11.38 {string match case, reverse range} {
2182 proc foo {} {string match {[A-fh-Z]} g}
2185 test string-11.39 {string match, *\ case} {
2186 proc foo {} {string match {*\abc} abc}
2189 test string-11.40 {string match, *special case} {
2190 proc foo {} {string match {*[ab]} abc}
2193 test string-11.41 {string match, *special case} {
2194 proc foo {} {string match {*[ab]*} abc}
2197 #test string-11.42 {string match, *special case} {
2198 # proc foo {} {string match "*\\" "\\"}
2199 # foo
2200 #} 0
2201 test string-11.43 {string match, *special case} {
2202 proc foo {} {string match "*\\\\" "\\"}
2205 test string-11.44 {string match, *special case} {
2206 proc foo {} {string match "*???" "12345"}
2209 test string-11.45 {string match, *special case} {
2210 proc foo {} {string match "*???" "12"}
2213 test string-11.46 {string match, *special case} {
2214 proc foo {} {string match "*\\*" "abc*"}
2217 test string-11.47 {string match, *special case} {
2218 proc foo {} {string match "*\\*" "*"}
2221 test string-11.48 {string match, *special case} {
2222 proc foo {} {string match "*\\*" "*abc"}
2225 test string-11.49 {string match, *special case} {
2226 proc foo {} {string match "?\\*" "a*"}
2229 #test string-11.50 {string match, *special case} {
2230 # proc foo {} {string match "\\" "\\"}
2231 # foo
2232 #} 0
2234 ## string length
2236 test string-9.1 {string length} {
2237 proc foo {} {string length}
2238 list [catch {foo} msg] $msg
2239 } {1 {wrong # args: should be "string length string"}}
2240 test string-9.2 {string length} {
2241 proc foo {} {string length a b}
2242 list [catch {foo} msg] $msg
2243 } {1 {wrong # args: should be "string length string"}}
2244 test string-9.3 {string length} {
2245 proc foo {} {string length "a little string"}
2247 } 15
2249 # string map
2251 test string-10.4 {string map} {
2252 string map {a b} abba
2253 } {bbbb}
2254 test string-10.5 {string map} {
2255 string map {a b} a
2256 } {b}
2257 test string-10.6 {string map -nocase} {
2258 string map -nocase {a b} Abba
2259 } {bbbb}
2260 test string-10.7 {string map} {
2261 string map {abc 321 ab * a A} aabcabaababcab
2262 } {A321*A*321*}
2263 test string-10.8 {string map -nocase} {
2264 string map -nocase {aBc 321 Ab * a A} aabcabaababcab
2265 } {A321*A*321*}
2266 test string-10.10 {string map} {
2267 list [catch {string map {a b c} abba} msg] $msg
2268 } {1 {list must contain an even number of elements}}
2269 test string-10.11 {string map, nulls} {
2270 string map {\x00 NULL blah \x00nix} {qwerty}
2271 } {qwerty}
2272 test string-10.12 {string map, unicode} {
2273 string map [list \374 ue UE \334] "a\374ueUE\000EU"
2274 } aueue\334\0EU
2275 test string-10.13 {string map, -nocase unicode} {
2276 string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"
2277 } aue\334\334\0EU
2278 test string-10.14 {string map, -nocase null arguments} {
2279 string map -nocase {{} abc} foo
2280 } foo
2281 test string-10.15 {string map, one pair case} {
2282 string map -nocase {abc 32} aAbCaBaAbAbcAb
2283 } {a32aBaAb32Ab}
2284 test string-10.16 {string map, one pair case} {
2285 string map -nocase {ab 4321} aAbCaBaAbAbcAb
2286 } {a4321C4321a43214321c4321}
2287 test string-10.17 {string map, one pair case} {
2288 string map {Ab 4321} aAbCaBaAbAbcAb
2289 } {a4321CaBa43214321c4321}
2290 test string-10.18 {string map, empty argument} {
2291 string map -nocase {{} abc} foo
2292 } foo
2293 test string-10.19 {string map, empty arguments} {
2294 string map -nocase {{} abc f bar {} def} foo
2295 } baroo
2297 ################################################################################
2298 # SPLIT
2299 ################################################################################
2301 test split-1.1 {basic split commands} {
2302 split "a\n b\t\r c\n "
2303 } {a {} b {} {} c {} {}}
2304 test split-1.2 {basic split commands} {
2305 split "word 1xyzword 2zword 3" xyz
2306 } {{word 1} {} {} {word 2} {word 3}}
2307 test split-1.3 {basic split commands} {
2308 split "12345" {}
2309 } {1 2 3 4 5}
2310 test split-1.4 {basic split commands} {
2311 split "a\}b\[c\{\]\$"
2312 } "a\\}b\\\[c\\{\\\]\\\$"
2313 test split-1.5 {basic split commands} {
2314 split {} {}
2315 } {}
2316 test split-1.6 {basic split commands} {
2317 split {}
2318 } {}
2319 test split-1.7 {basic split commands} {
2320 split { }
2321 } {{} {} {} {}}
2322 test split-1.8 {basic split commands} {
2323 proc foo {} {
2324 set x {}
2325 foreach f [split {]\n} {}] {
2326 append x $f
2328 return $x
2331 } {]\n}
2332 test split-1.9 {basic split commands} {
2333 proc foo {} {
2334 set x ab\000c
2335 set y [split $x {}]
2336 return $y
2339 } "a b \000 c"
2340 test split-1.10 {basic split commands} {
2341 split "a0ab1b2bbb3\000c4" ab\000c
2342 } {{} 0 {} 1 2 {} {} 3 {} 4}
2343 test split-1.11 {basic split commands} {
2344 split "12,3,45" {,}
2345 } {12 3 45}
2346 #test split-1.12 {basic split commands} {
2347 # split "\u0001ab\u0001cd\u0001\u0001ef\u0001" \1
2348 #} {{} ab cd {} ef {}}
2349 test split-1.13 {basic split commands} {
2350 split "12,34,56," {,}
2351 } {12 34 56 {}}
2352 test split-1.14 {basic split commands} {
2353 split ",12,,,34,56," {,}
2354 } {{} 12 {} {} 34 56 {}}
2356 test split-2.1 {split errors} {
2357 list [catch split msg] $msg
2358 } {1 {wrong # args: should be "split string ?splitChars?"}}
2359 test split-2.2 {split errors} {
2360 list [catch {split a b c} msg] $msg
2361 } {1 {wrong # args: should be "split string ?splitChars?"}}
2363 # cleanup
2364 catch {rename foo {}}
2366 ################################################################################
2367 # JOIN
2368 ################################################################################
2370 test join-1.1 {basic join commands} {
2371 join {a b c} xyz
2372 } axyzbxyzc
2373 test join-1.2 {basic join commands} {
2374 join {a b c} {}
2375 } abc
2376 test join-1.3 {basic join commands} {
2377 join {} xyz
2378 } {}
2379 test join-1.4 {basic join commands} {
2380 join {12 34 56}
2381 } {12 34 56}
2383 test join-2.1 {join errors} {
2384 list [catch join msg] $msg
2385 } {1 {wrong # args: should be "join list ?joinString?"}}
2386 test join-2.2 {join errors} {
2387 list [catch {join a b c} msg] $msg
2388 } {1 {wrong # args: should be "join list ?joinString?"}}
2389 #test join-2.3 {join errors} {
2390 # list [catch {join "a \{ c" 111} msg] $msg
2391 #} {1 {unmatched open brace in list}}
2393 test join-3.1 {joinString is binary ok} {
2394 string length [join {a b c} a\0b]
2397 test join-3.2 {join is binary ok} {
2398 string length [join "a\0b a\0b a\0b"]
2399 } 11
2401 ################################################################################
2402 # SWITCH
2403 ################################################################################
2405 test switch-1.1 {simple patterns} {
2406 switch a a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2408 test switch-1.2 {simple patterns} {
2409 switch b a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2411 test switch-1.3 {simple patterns} {
2412 switch x a {expr 1} b {expr 2} c {expr 3} default {expr 4}
2414 test switch-1.4 {simple patterns} {
2415 switch x a {expr 1} b {expr 2} c {expr 3}
2416 } {}
2417 test switch-1.5 {simple pattern matches many times} {
2418 switch b a {expr 1} b {expr 2} b {expr 3} b {expr 4}
2420 test switch-1.6 {simple patterns} {
2421 switch default a {expr 1} default {expr 2} c {expr 3} default {expr 4}
2423 test switch-1.7 {simple patterns} {
2424 switch x a {expr 1} default {expr 2} c {expr 3} default {expr 4}
2427 test switch-2.1 {single-argument form for pattern/command pairs} {
2428 switch b {
2429 a {expr 1}
2430 b {expr 2}
2431 default {expr 6}
2433 } {2}
2434 test switch-2.2 {single-argument form for pattern/command pairs} {
2435 list [catch {switch z {a 2 b}}]
2438 test switch-3.1 {-exact vs. -glob vs. -regexp} {
2439 switch -exact aaaab {
2440 ^a*b$ {concat regexp}
2441 *b {concat glob}
2442 aaaab {concat exact}
2443 default {concat none}
2445 } exact
2446 test switch-3.2 {-exact vs. -glob vs. -regexp (no [regexp] cmd)} {
2447 catch {
2448 switch -regexp aaaab {
2449 ^a*b$ {concat regexp}
2450 *b {concat glob}
2451 aaaab {concat exact}
2452 default {concat none}
2456 test switch-3.3 {-exact vs. -glob vs. -regexp (with [regexp] cmd)} {
2457 proc regexp {pat str} {expr {$pat eq "^a*b$" && $str eq "aaaab"}}
2458 switch -regexp aaaab {
2459 ^a*b$ {concat regexp}
2460 *b {concat glob}
2461 aaaab {concat exact}
2462 default {concat none}
2464 } regexp
2465 test switch-3.4 {-exact vs. -glob vs. -regexp} {
2466 switch -glob aaaab {
2467 ^a*b$ {concat regexp}
2468 *b {concat glob}
2469 aaaab {concat exact}
2470 default {concat none}
2472 } glob
2473 test switch-3.5 {-exact vs. -glob vs. -regexp} {
2474 switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
2475 aaaab {concat exact} default {concat none}
2476 } exact
2477 test switch-3.6 {-exact vs. -glob vs. -regexp} {
2478 switch -- -glob {
2479 ^g.*b$ {concat regexp}
2480 -* {concat glob}
2481 -glob {concat exact}
2482 default {concat none}
2484 } exact
2485 test switch-3.7 {-exact vs. -glob vs. -regexp} {
2486 list [catch {switch -foo a b c} msg] $msg
2487 } {1 {bad option "-foo": must be -exact, -glob, -regexp, -command procname or --}}
2489 test switch-4.1 {error in executed command} {
2490 list [catch {switch a a {error "Just a test"} default {expr 1}} msg] \
2491 $msg
2492 } {1 {Just a test}}
2493 test switch-4.2 {error: not enough args} {
2494 catch {switch}
2496 test switch-4.3 {error: pattern with no body} {
2497 catch {switch a b}
2499 test switch-4.4 {error: pattern with no body} {
2500 catch {switch a b {expr 1} c}
2502 test switch-4.5 {error in default command} {
2503 list [catch {switch foo a {error switch1} b {error switch 3} \
2504 default {error switch2}} msg] $msg
2505 } {1 switch2}
2507 #~ test switch-5.1 {errors in -regexp matching} {
2508 #~ list [catch {switch -regexp aaaab {
2509 #~ *b {concat glob}
2510 #~ aaaab {concat exact}
2511 #~ default {concat none}
2512 #~ }} msg] $msg
2513 #~ } {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
2515 test switch-6.1 {backslashes in patterns} {
2516 switch -exact {\a\$\.\[} {
2517 \a\$\.\[ {concat first}
2518 \a\\$\.\\[ {concat second}
2519 \\a\\$\\.\\[ {concat third}
2520 {\a\\$\.\\[} {concat fourth}
2521 {\\a\\$\\.\\[} {concat fifth}
2522 default {concat none}
2524 } third
2525 test switch-6.2 {backslashes in patterns} {
2526 switch -exact {\a\$\.\[} {
2527 \a\$\.\[ {concat first}
2528 {\a\$\.\[} {concat second}
2529 {{\a\$\.\[}} {concat third}
2530 default {concat none}
2532 } second
2534 test switch-7.1 {"-" bodies} {
2535 switch a {
2538 c {concat 1}
2539 default {concat 2}
2542 test switch-7.2 {"-" bodies} {
2543 list [catch {
2544 switch a {
2549 } msg] $msg
2550 } {1 {no body specified for pattern "c"}}
2551 # Following original Tcl test makes no sense, I feel! Please review ...
2552 #~ test switch-7.3 {"-" bodies} {
2553 #~ list [catch {
2554 #~ switch a {
2555 #~ a -
2556 #~ b -foo
2557 #~ c -
2558 #~ }
2559 #~ } msg] $msg
2560 #~ } {1 {no body specified for pattern "c"}}
2561 test switch-7.3 {"-" bodies} {
2562 list [catch {
2563 switch a {
2565 b -foo
2568 } msg] $msg
2569 } {1 {invalid command name "-foo"}}
2571 test switch-8.1 {empty body} {
2572 set msg {}
2573 switch {2} {
2574 1 {set msg 1}
2575 2 {}
2576 default {set msg 2}
2578 } {}
2580 test switch-9.1 {empty pattern/body list} {
2581 catch {switch x}
2583 test switch-9.2 {empty pattern/body list} {
2584 catch {switch -- x}
2585 } 1
2586 test switch-9.3 {empty pattern/body list} {
2587 catch {switch x {}}
2589 test switch-9.4 {empty pattern/body list} {
2590 catch {switch -- x {}}
2592 test switch-9.5 {unpaired pattern} {
2593 catch {switch x a {} b}
2595 test switch-9.6 {unpaired pattern} {
2596 catch {switch x {a {} b}}
2598 test switch-9.7 {unpaired pattern} {
2599 catch {switch x a {} # comment b}
2601 test switch-9.8 {unpaired pattern} {
2602 catch {switch x {a {} # comment b}}
2604 test switch-9.9 {unpaired pattern} {
2605 catch {switch x a {} x {} # comment b}
2607 test switch-9.10 {unpaired pattern} {
2608 catch {switch x {a {} x {} # comment b}}
2611 test switch-10.1 {no callback given to -command} {
2612 catch {switch -command a { a {expr 1} b {expr 2} }}
2614 test switch-10.2 {callback expect wrong # args for -command} {
2615 catch {switch -command [lambda {p1} {expr 1}] a { a {expr 1} b {expr 2} }}
2617 test switch-10.3 {callback to -command returns ever 0: no match} {
2618 switch -command [lambda {p1 p2} {expr 0}] a a {expr 1} b {expr 2}
2619 } {}
2620 test switch-10.4 {callback to -command returns 3 at first match} {
2621 switch -command [lambda {p1 p2} {expr 3}] a a {expr 1} b {expr 2}
2623 test switch-10.5 {[error] in callback to -command} {
2624 list [catch {
2625 switch -command [lambda {p1 p2} {error "foo"}] a a {expr 1} b {expr 2}
2626 } msg] $msg
2627 } {1 foo}
2628 test switch-10.6 {[continue] in callback to -command} {
2629 list [catch {
2630 switch -command [lambda {p1 p2} {continue}] a a {expr 1} b {expr 2}
2631 } msg] $msg
2632 } {4 {}}
2633 test switch-10.7 {callback matches first if pat < str} {
2634 switch -command [lambda {pat str} {expr {$pat < $str}}] 3 \
2635 5 {expr 1} 3 {expr 2}
2636 } {}
2637 test switch-10.8 {callback matches first if pat < str} {
2638 switch -command [lambda {pat str} {expr {$pat < $str}}] 7 \
2639 5 {expr 1} 3 {expr 2}
2641 test switch-10.9 {callback matches first if pat < str} {
2642 switch -command [lambda {pat str} {expr {$pat < $str}}] 4 \
2643 5 {expr 1} 3 {expr 2}
2646 ################################################################################
2647 # FOR
2648 ################################################################################
2650 # Basic "for" operation.
2652 test for-1.1 {TclCompileForCmd: missing initial command} {
2653 list [catch {for} msg] $msg
2654 } {1 {wrong # args: should be "for start test next body"}}
2655 test for-1.2 {TclCompileForCmd: error in initial command} {
2656 list [catch {for {set}} msg] $msg
2657 } {1 {wrong # args: should be "for start test next body"}}
2658 catch {unset i}
2659 test for-1.3 {TclCompileForCmd: missing test expression} {
2660 catch {for {set i 0}} msg
2661 set msg
2662 } {wrong # args: should be "for start test next body"}
2663 test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
2664 set i 0
2665 for {} "$i > 5" {incr i} {}
2666 } {}
2667 test for-1.6 {TclCompileForCmd: missing "next" command} {
2668 catch {for {set i 0} {$i < 5}} msg
2669 set msg
2670 } {wrong # args: should be "for start test next body"}
2671 test for-1.7 {TclCompileForCmd: missing command body} {
2672 catch {for {set i 0} {$i < 5} {incr i}} msg
2673 set msg
2674 } {wrong # args: should be "for start test next body"}
2675 catch {unset a}
2676 test for-1.9 {TclCompileForCmd: simple command body} {
2677 set a {}
2678 for {set i 1} {$i<6} {set i [expr $i+1]} {
2679 if $i==4 break
2680 set a [concat $a $i]
2682 set a
2683 } {1 2 3}
2684 test for-1.10 {TclCompileForCmd: command body in quotes} {
2685 set a {}
2686 for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2687 set a
2688 } {xxxxx}
2689 test for-1.11 {TclCompileForCmd: computed command body} {
2690 catch {unset x1}
2691 catch {unset bb}
2692 catch {unset x2}
2693 set x1 {append a x1; }
2694 set bb {break}
2695 set x2 {; append a x2}
2696 set a {}
2697 for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
2698 set a
2699 } {x1}
2700 test for-1.13 {TclCompileForCmd: long command body} {
2701 set a {}
2702 for {set i 1} {$i<6} {set i [expr $i+1]} {
2703 if $i==4 break
2704 if $i>5 continue
2705 set tcl_platform(machine) i686
2706 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2707 catch {set a $a} msg
2708 catch {incr i 5} msg
2709 catch {incr i -5} msg
2711 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2712 catch {set a $a} msg
2713 catch {incr i 5} msg
2714 catch {incr i -5} msg
2716 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2717 catch {set a $a} msg
2718 catch {incr i 5} msg
2719 catch {incr i -5} msg
2721 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2722 catch {set a $a} msg
2723 catch {incr i 5} msg
2724 catch {incr i -5} msg
2726 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2727 catch {set a $a} msg
2728 catch {incr i 5} msg
2729 catch {incr i -5} msg
2731 set a [concat $a $i]
2733 set a
2734 } {1 2 3}
2735 test for-1.14 {TclCompileForCmd: for command result} {
2736 set a [for {set i 0} {$i < 5} {incr i} {}]
2737 set a
2738 } {}
2739 test for-1.15 {TclCompileForCmd: for command result} {
2740 set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
2741 set a
2742 } {}
2744 # Check "for" and "continue".
2746 test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
2747 catch {continue foo} msg
2748 set msg
2749 } {wrong # args: should be "continue"}
2750 test for-2.2 {TclCompileContinueCmd: continue result} {
2751 catch continue
2753 test for-2.3 {continue tests} {
2754 set a {}
2755 for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2756 if {$i == 2} continue
2757 set a [concat $a $i]
2759 set a
2760 } {1 3 4}
2761 test for-2.4 {continue tests} {
2762 set a {}
2763 for {set i 1} {$i <= 4} {set i [expr $i+1]} {
2764 if {$i != 2} continue
2765 set a [concat $a $i]
2767 set a
2768 } {2}
2769 test for-2.5 {continue tests, nested loops} {
2770 set msg {}
2771 for {set i 1} {$i <= 4} {incr i} {
2772 for {set a 1} {$a <= 2} {incr a} {
2773 if {$i>=2 && $a>=2} continue
2774 set msg [concat $msg "$i.$a"]
2777 set msg
2778 } {1.1 1.2 2.1 3.1 4.1}
2779 test for-2.6 {continue tests, long command body} {
2780 set a {}
2781 for {set i 1} {$i<6} {set i [expr $i+1]} {
2782 if $i==2 continue
2783 if $i==4 break
2784 if $i>5 continue
2785 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2786 catch {set a $a} msg
2787 catch {incr i 5} msg
2788 catch {incr i -5} msg
2790 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2791 catch {set a $a} msg
2792 catch {incr i 5} msg
2793 catch {incr i -5} msg
2795 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2796 catch {set a $a} msg
2797 catch {incr i 5} msg
2798 catch {incr i -5} msg
2800 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2801 catch {set a $a} msg
2802 catch {incr i 5} msg
2803 catch {incr i -5} msg
2805 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2806 catch {set a $a} msg
2807 catch {incr i 5} msg
2808 catch {incr i -5} msg
2810 set a [concat $a $i]
2812 set a
2813 } {1 3}
2815 # Check "for" and "break".
2817 test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
2818 catch {break foo} msg
2819 set msg
2820 } {wrong # args: should be "break"}
2821 test for-3.2 {TclCompileBreakCmd: break result} {
2822 catch break
2824 test for-3.3 {break tests} {
2825 set a {}
2826 for {set i 1} {$i <= 4} {incr i} {
2827 if {$i == 3} break
2828 set a [concat $a $i]
2830 set a
2831 } {1 2}
2832 test for-3.4 {break tests, nested loops} {
2833 set msg {}
2834 for {set i 1} {$i <= 4} {incr i} {
2835 for {set a 1} {$a <= 2} {incr a} {
2836 if {$i>=2 && $a>=2} break
2837 set msg [concat $msg "$i.$a"]
2840 set msg
2841 } {1.1 1.2 2.1 3.1 4.1}
2842 test for-3.5 {break tests, long command body} {
2843 set a {}
2844 for {set i 1} {$i<6} {set i [expr $i+1]} {
2845 if $i==2 continue
2846 if $i==5 break
2847 if $i>5 continue
2848 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2849 catch {set a $a} msg
2850 catch {incr i 5} msg
2851 catch {incr i -5} msg
2853 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2854 catch {set a $a} msg
2855 catch {incr i 5} msg
2856 catch {incr i -5} msg
2858 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2859 catch {set a $a} msg
2860 catch {incr i 5} msg
2861 catch {incr i -5} msg
2863 if {$i == 4} break
2864 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2865 catch {set a $a} msg
2866 catch {incr i 5} msg
2867 catch {incr i -5} msg
2869 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
2870 catch {set a $a} msg
2871 catch {incr i 5} msg
2872 catch {incr i -5} msg
2874 set a [concat $a $i]
2876 set a
2877 } {1 3}
2878 test for-4.1 {break must reset the interp result} {
2879 catch {
2880 set z GLOBTESTDIR/dir2/file2.c
2881 if [string match GLOBTESTDIR/dir2/* $z] {
2882 break
2885 set j
2886 } {}
2888 # Test for incorrect "double evaluation" semantics
2890 test for-5.1 {possible delayed substitution of increment command} {
2891 # Increment should be 5, and lappend should always append $a
2892 catch {unset a}
2893 catch {unset i}
2894 set a 5
2895 set i {}
2896 for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2897 set i
2898 } {1 6 11}
2900 test for-5.2 {possible delayed substitution of increment command} {
2901 # Increment should be 5, and lappend should always append $a
2902 catch {rename p ""}
2903 proc p {} {
2904 set a 5
2905 set i {}
2906 for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
2907 set i
2910 } {1 6 11}
2911 test for-5.3 {possible delayed substitution of body command} {
2912 # Increment should be $a, and lappend should always append 5
2913 set a 5
2914 set i {}
2915 for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2916 set i
2917 } {5 5 5 5}
2918 test for-5.4 {possible delayed substitution of body command} {
2919 # Increment should be $a, and lappend should always append 5
2920 catch {rename p ""}
2921 proc p {} {
2922 set a 5
2923 set i {}
2924 for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
2925 set i
2928 } {5 5 5 5}
2930 # In the following tests we need to bypass the bytecode compiler by
2931 # substituting the command from a variable. This ensures that command
2932 # procedure is invoked directly.
2934 test for-6.1 {Tcl_ForObjCmd: number of args} {
2935 set z for
2936 catch {$z} msg
2937 set msg
2938 } {wrong # args: should be "for start test next body"}
2939 test for-6.2 {Tcl_ForObjCmd: number of args} {
2940 set z for
2941 catch {$z {set i 0}} msg
2942 set msg
2943 } {wrong # args: should be "for start test next body"}
2944 test for-6.3 {Tcl_ForObjCmd: number of args} {
2945 set z for
2946 catch {$z {set i 0} {$i < 5}} msg
2947 set msg
2948 } {wrong # args: should be "for start test next body"}
2949 test for-6.4 {Tcl_ForObjCmd: number of args} {
2950 set z for
2951 catch {$z {set i 0} {$i < 5} {incr i}} msg
2952 set msg
2953 } {wrong # args: should be "for start test next body"}
2954 test for-6.5 {Tcl_ForObjCmd: number of args} {
2955 set z for
2956 catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
2957 set msg
2958 } {wrong # args: should be "for start test next body"}
2959 test for-6.6 {Tcl_ForObjCmd: error in initial command} {
2960 set z for
2961 list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg
2962 } {1 {wrong # args: should be "set varName ?newValue?"}}
2963 test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
2964 set z for
2965 set i 0
2966 $z {set i 6} "$i > 5" {incr i} {set y $i}
2967 set i
2969 test for-6.10 {Tcl_ForObjCmd: simple command body} {
2970 set z for
2971 set a {}
2972 $z {set i 1} {$i<6} {set i [expr $i+1]} {
2973 if $i==4 break
2974 set a [concat $a $i]
2976 set a
2977 } {1 2 3}
2978 test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
2979 set z for
2980 set a {}
2981 $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
2982 set a
2983 } {xxxxx}
2984 test for-6.12 {Tcl_ForObjCmd: computed command body} {
2985 set z for
2986 catch {unset x1}
2987 catch {unset bb}
2988 catch {unset x2}
2989 set x1 {append a x1; }
2990 set bb {break}
2991 set x2 {; append a x2}
2992 set a {}
2993 $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
2994 set a
2995 } {x1}
2996 test for-6.14 {Tcl_ForObjCmd: long command body} {
2997 set z for
2998 set a {}
2999 $z {set i 1} {$i<6} {set i [expr $i+1]} {
3000 if $i==4 break
3001 if $i>5 continue
3002 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3003 catch {set a $a} msg
3004 catch {incr i 5} msg
3005 catch {incr i -5} msg
3007 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3008 catch {set a $a} msg
3009 catch {incr i 5} msg
3010 catch {incr i -5} msg
3012 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3013 catch {set a $a} msg
3014 catch {incr i 5} msg
3015 catch {incr i -5} msg
3017 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3018 catch {set a $a} msg
3019 catch {incr i 5} msg
3020 catch {incr i -5} msg
3022 if {$i>6 && $tcl_platform(machine) eq "xxx"} {
3023 catch {set a $a} msg
3024 catch {incr i 5} msg
3025 catch {incr i -5} msg
3027 set a [concat $a $i]
3029 set a
3030 } {1 2 3}
3031 test for-6.15 {Tcl_ForObjCmd: for command result} {
3032 set z for
3033 set a [$z {set i 0} {$i < 5} {incr i} {}]
3034 set a
3035 } {}
3036 test for-6.16 {Tcl_ForObjCmd: for command result} {
3037 set z for
3038 set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
3039 set a
3040 } {}
3042 ################################################################################
3043 # INFO
3044 ################################################################################
3046 test info-1.1 {info body option} {
3047 proc t1 {} {body of t1}
3048 info body t1
3049 } {body of t1}
3050 test info-1.2 {info body option} {
3051 list [catch {info body set} msg] $msg
3052 } {1 {command "set" is not a procedure}}
3053 #~ test info-1.3 {info body option} {
3054 #~ list [catch {info args set 1} msg] $msg
3055 #~ } {1 {wrong # args: should be "info args procname"}}
3056 test info-1.5 {info body option, returning bytecompiled bodies} {
3057 catch {unset args}
3058 proc foo {args} {
3059 foreach v $args {
3060 upvar $v var
3061 return "variable $v existence: [info exists var]"
3064 foo a
3065 list [catch [info body foo] msg] $msg
3066 } {1 {can't read "args": no such variable}}
3067 #~ test info-1.6 {info body option, returning list bodies} {
3068 #~ proc foo args [list subst bar]
3069 #~ list [string bytelength [info body foo]] \
3070 #~ [foo; string bytelength [info body foo]]
3071 #~ } {9 9}
3072 test info-2.1 {info commands option} {
3073 proc t1 {} {}
3074 proc t2 {} {}
3075 set x " [info commands] "
3076 list [string match {* t1 *} $x] [string match {* t2 *} $x] \
3077 [string match {* set *} $x] [string match {* list *} $x]
3078 } {1 1 1 1}
3079 test info-2.2 {info commands option} {
3080 proc t1 {} {}
3081 rename t1 {}
3082 set x [info commands]
3083 string match {* t1 *} $x
3085 test info-2.3 {info commands option} {
3086 proc _t1_ {} {}
3087 proc _t2_ {} {}
3088 info commands _t1_
3089 } _t1_
3090 test info-2.4 {info commands option} {
3091 proc _t1_ {} {}
3092 proc _t2_ {} {}
3093 lsort [info commands _t*]
3094 } {_t1_ _t2_}
3095 catch {rename _t1_ {}}
3096 catch {rename _t2_ {}}
3097 test info-2.5 {info commands option} {
3098 list [catch {info commands a b} msg] $msg
3099 } {1 {wrong # args: should be "info commands ?pattern?"}}
3100 test info-3.1 {info exists option} {
3101 set value foo
3102 info exists value
3104 catch {unset _nonexistent_}
3105 test info-3.2 {info exists option} {
3106 info exists _nonexistent_
3108 test info-3.3 {info exists option} {
3109 proc t1 {x} {return [info exists x]}
3110 t1 2
3112 test info-3.4 {info exists option} {
3113 proc t1 {x} {
3114 global _nonexistent_
3115 return [info exists _nonexistent_]
3117 t1 2
3119 test info-3.5 {info exists option} {
3120 proc t1 {x} {
3121 set y 47
3122 return [info exists y]
3124 t1 2
3126 test info-3.6 {info exists option} {
3127 proc t1 {x} {return [info exists value]}
3128 t1 2
3130 test info-3.7 {info exists option} {
3131 catch {unset x}
3132 set x(2) 44
3133 list [info exists x] [info exists x(1)] [info exists x(2)]
3134 } {1 0 1}
3135 catch {unset x}
3136 test info-3.8 {info exists option} {
3137 list [catch {info exists} msg] $msg
3138 } {1 {wrong # args: should be "info exists varName"}}
3139 test info-3.9 {info exists option} {
3140 list [catch {info exists 1 2} msg] $msg
3141 } {1 {wrong # args: should be "info exists varName"}}
3142 test info-4.1 {info globals option} {
3143 set x 1
3144 set y 2
3145 set value 23
3146 set a " [info globals] "
3147 list [string match {* x *} $a] [string match {* y *} $a] \
3148 [string match {* value *} $a] [string match {* _foobar_ *} $a]
3149 } {1 1 1 0}
3150 test info-4.2 {info globals option} {
3151 set _xxx1 1
3152 set _xxx2 2
3153 lsort [info globals _xxx*]
3154 } {_xxx1 _xxx2}
3155 test info-4.3 {info globals option} {
3156 list [catch {info globals 1 2} msg] $msg
3157 } {1 {wrong # args: should be "info globals ?pattern?"}}
3158 test info-5.1 {info level option} {
3159 info level
3162 test info-5.2 {info level option} {
3163 proc t1 {a b} {
3164 set x [info level]
3165 set y [info level 1]
3166 list $x $y
3168 t1 146 testString
3169 } {1 {t1 146 testString}}
3170 test info-5.3 {info level option} {
3171 proc t1 {a b} {
3172 t2 [expr $a*2] $b
3174 proc t2 {x y} {
3175 list [info level] [info level 1] [info level 2] [info level -1] \
3176 [info level 0]
3178 t1 146 {a {b c} {{{c}}}}
3179 } {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}}}}}}
3180 test info-5.4 {info level option} {
3181 proc t1 {} {
3182 set x [info level]
3183 set y [info level 1]
3184 list $x $y
3187 } {1 t1}
3188 test info-5.5 {info level option} {
3189 list [catch {info level 1 2} msg] $msg
3190 } {1 {wrong # args: should be "info level ?levelNum?"}}
3191 test info-5.6 {info level option} {
3192 list [catch {info level 123a} msg] $msg
3193 } {1 {bad level "123a"}}
3194 test info-5.7 {info level option} {
3195 list [catch {info level 0} msg] $msg
3196 } {1 {bad level "0"}}
3197 test info-5.8 {info level option} {
3198 proc t1 {} {info level -1}
3199 list [catch {t1} msg] $msg
3200 } {1 {bad level "-1"}}
3201 test info-5.9 {info level option} {
3202 proc t1 {x} {info level $x}
3203 list [catch {t1 -3} msg] $msg
3204 } {1 {bad level "-3"}}
3205 test info-6.1 {info locals option} {
3206 set a 22
3207 proc t1 {x y} {
3208 set b 13
3209 set c testing
3210 global a
3211 global aa
3212 set aa 23
3213 return [info locals]
3215 lsort [t1 23 24]
3216 } {b c x y}
3217 test info-6.2 {info locals option} {
3218 proc t1 {x y} {
3219 set xx1 2
3220 set xx2 3
3221 set y 4
3222 return [info locals x*]
3224 lsort [t1 2 3]
3225 } {x xx1 xx2}
3226 test info-6.3 {info locals option} {
3227 list [catch {info locals 1 2} msg] $msg
3228 } {1 {wrong # args: should be "info locals ?pattern?"}}
3229 test info-6.4 {info locals option} {
3230 info locals
3231 } {}
3232 test info-6.5 {info locals option} {
3233 proc t1 {} {return [info locals]}
3235 } {}
3236 test info-6.6 {info locals vs unset compiled locals} {
3237 proc t1 {lst} {
3238 foreach $lst $lst {}
3239 unset lst
3240 return [info locals]
3242 lsort [t1 {a b c c d e f}]
3243 } {a b c d e f}
3244 test info-6.7 {info locals with temporary variables} {
3245 proc t1 {} {
3246 foreach a {b c} {}
3247 info locals
3250 } {a}
3251 test info-7.1 {info vars option} {
3252 set a 1
3253 set b 2
3254 proc t1 {x y} {
3255 global a b
3256 set c 33
3257 return [info vars]
3259 lsort [t1 18 19]
3260 } {a b c x y}
3261 test info-7.2 {info vars option} {
3262 set xxx1 1
3263 set xxx2 2
3264 proc t1 {xxa y} {
3265 global xxx1 xxx2
3266 set c 33
3267 return [info vars x*]
3269 lsort [t1 18 19]
3270 } {xxa xxx1 xxx2}
3271 test info-7.3 {info vars option} {
3272 lsort [info vars]
3273 } [lsort [info globals]]
3274 test info-7.4 {info vars option} {
3275 list [catch {info vars a b} msg] $msg
3276 } {1 {wrong # args: should be "info vars ?pattern?"}}
3277 test info-7.5 {info vars with temporary variables} {
3278 proc t1 {} {
3279 foreach a {b c} {}
3280 info vars
3283 } {a}
3286 ################################################################################
3287 # linsert
3288 ################################################################################
3290 test linsert-1.1 {linsert command} {
3291 linsert {1 2 3 4 5} 0 a
3292 } {a 1 2 3 4 5}
3293 test linsert-1.2 {linsert command} {
3294 linsert {1 2 3 4 5} 1 a
3295 } {1 a 2 3 4 5}
3296 test linsert-1.3 {linsert command} {
3297 linsert {1 2 3 4 5} 2 a
3298 } {1 2 a 3 4 5}
3299 test linsert-1.4 {linsert command} {
3300 linsert {1 2 3 4 5} 3 a
3301 } {1 2 3 a 4 5}
3302 test linsert-1.5 {linsert command} {
3303 linsert {1 2 3 4 5} 4 a
3304 } {1 2 3 4 a 5}
3305 test linsert-1.6 {linsert command} {
3306 linsert {1 2 3 4 5} 5 a
3307 } {1 2 3 4 5 a}
3308 test linsert-1.7 {linsert command} {
3309 linsert {1 2 3 4 5} 2 one two \{three \$four
3310 } {1 2 one two \{three {$four} 3 4 5}
3311 test linsert-1.8 {linsert command} {
3312 linsert {\{one \$two \{three \ four \ five} 2 a b c
3313 } {\{one {$two} a b c \{three { four} { five}}
3314 test linsert-1.9 {linsert command} {
3315 linsert {{1 2} {3 4} {5 6} {7 8}} 2 {x y} {a b}
3316 } {{1 2} {3 4} {x y} {a b} {5 6} {7 8}}
3317 test linsert-1.10 {linsert command} {
3318 linsert {} 2 a b c
3319 } {a b c}
3320 test linsert-1.11 {linsert command} {
3321 linsert {} 2 {}
3322 } {{}}
3323 test linsert-1.12 {linsert command} {
3324 linsert {a b "c c" d e} 3 1
3325 } {a b {c c} 1 d e}
3326 test linsert-1.13 {linsert command} {
3327 linsert { a b c d} 0 1 2
3328 } {1 2 a b c d}
3329 test linsert-1.14 {linsert command} {
3330 linsert {a b c {d e f}} 4 1 2
3331 } {a b c {d e f} 1 2}
3332 test linsert-1.15 {linsert command} {
3333 linsert {a b c \{\ abc} 4 q r
3334 } {a b c \{\ q r abc}
3335 test linsert-1.16 {linsert command} {
3336 linsert {a b c \{ abc} 4 q r
3337 } {a b c \{ q r abc}
3338 test linsert-1.17 {linsert command} {
3339 linsert {a b c} end q r
3340 } {a b c q r}
3341 test linsert-1.18 {linsert command} {
3342 linsert {a} end q r
3343 } {a q r}
3344 test linsert-1.19 {linsert command} {
3345 linsert {} end q r
3346 } {q r}
3347 test linsert-1.20 {linsert command, use of end-int index} {
3348 linsert {a b c d} end-2 e f
3349 } {a b e f c d}
3351 test linsert-2.1 {linsert errors} {
3352 list [catch linsert msg] $msg
3353 } {1 {wrong # args: should be "linsert list index element ?element ...?"}}
3354 test linsert-2.2 {linsert errors} {
3355 list [catch {linsert a b} msg] $msg
3356 } {1 {wrong # args: should be "linsert list index element ?element ...?"}}
3357 test linsert-2.3 {linsert errors} {
3358 list [catch {linsert a 12x 2} msg] $msg
3359 } {1 {bad index "12x": must be integer or end?-integer?}}
3361 test linsert-3.1 {linsert won't modify shared argument objects} {
3362 proc p {} {
3363 linsert "a b c" 1 "x y"
3364 return "a b c"
3367 } "a b c"
3368 test linsert-3.2 {linsert won't modify shared argument objects} {
3369 catch {unset lis}
3370 set lis [concat a \"b\" c]
3371 linsert $lis 0 [string length $lis]
3372 } "7 a b c"
3374 ################################################################################
3375 # LRANGE
3376 ################################################################################
3378 test lrange-1.1 {range of list elements} {
3379 lrange {a b c d} 1 2
3380 } {b c}
3381 test lrange-1.2 {range of list elements} {
3382 lrange {a {bcd e {f g {}}} l14 l15 d} 1 1
3383 } {{bcd e {f g {}}}}
3384 test lrange-1.3 {range of list elements} {
3385 lrange {a {bcd e {f g {}}} l14 l15 d} 3 end
3386 } {l15 d}
3387 test lrange-1.4 {range of list elements} {
3388 lrange {a {bcd e {f g {}}} l14 l15 d} 4 10000
3389 } {d}
3390 test lrange-1.5 {range of list elements} {
3391 lrange {a {bcd e {f g {}}} l14 l15 d} 4 3
3392 } {}
3393 test lrange-1.6 {range of list elements} {
3394 lrange {a {bcd e {f g {}}} l14 l15 d} 10 11
3395 } {}
3396 test lrange-1.7 {range of list elements} {
3397 lrange {a b c d e} -1 2
3398 } {a b c}
3399 test lrange-1.8 {range of list elements} {
3400 lrange {a b c d e} -2 -1
3401 } {}
3402 #test lrange-1.9 {range of list elements} {
3403 # lrange {a b c d e} -2 e
3404 #} {a b c d e}
3405 test lrange-1.10 {range of list elements} {
3406 lrange "a b\{c d" 1 2
3407 } "b\\{c d"
3408 test lrange-1.11 {range of list elements} {
3409 lrange "a b c d" end end
3411 test lrange-1.12 {range of list elements} {
3412 lrange "a b c d" end 100000
3414 #test lrange-1.13 {range of list elements} {
3415 # lrange "a b c d" e 3
3416 #} d
3417 test lrange-1.14 {range of list elements} {
3418 lrange "a b c d" end 2
3419 } {}
3420 test lrange-1.15 {range of list elements} {
3421 concat \"[lrange {a b \{\ } 0 2]"
3422 } {"a b \{\ "}
3423 test lrange-1.16 {list element quoting} {
3424 lrange {[append a .b]} 0 end
3425 } {{[append} a .b\]}
3427 test lrange-2.1 {error conditions} {
3428 list [catch {lrange a b} msg] $msg
3429 } {1 {wrong # args: should be "lrange list first last"}}
3430 test lrange-2.2 {error conditions} {
3431 list [catch {lrange a b 6 7} msg] $msg
3432 } {1 {wrong # args: should be "lrange list first last"}}
3433 test lrange-2.3 {error conditions} {
3434 list [catch {lrange a b 6} msg] $msg
3435 } {1 {bad index "b": must be integer or end?-integer?}}
3436 test lrange-2.4 {error conditions} {
3437 list [catch {lrange a 0 enigma} msg] $msg
3438 } {1 {bad index "enigma": must be integer or end?-integer?}}
3439 #test lrange-2.5 {error conditions} {
3440 # list [catch {lrange "a \{b c" 3 4} msg] $msg
3441 #} {1 {unmatched open brace in list}}
3442 #test lrange-2.6 {error conditions} {
3443 # list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
3444 #} {1 {unmatched open brace in list}}
3446 ################################################################################
3447 # SCAN
3448 ################################################################################
3450 test scan-1.1 {BuildCharSet, CharInSet} {
3451 list [scan foo {%[^o]} x] $x
3452 } {1 f}
3453 test scan-1.2 {BuildCharSet, CharInSet} {
3454 list [scan \]foo {%[]f]} x] $x
3455 } {1 {]f}}
3456 test scan-1.3 {BuildCharSet, CharInSet} {
3457 list [scan abc-def {%[a-c]} x] $x
3458 } {1 abc}
3459 test scan-1.4 {BuildCharSet, CharInSet} {
3460 list [scan abc-def {%[a-c]} x] $x
3461 } {1 abc}
3462 test scan-1.5 {BuildCharSet, CharInSet} {
3463 list [scan -abc-def {%[-ac]} x] $x
3464 } {1 -a}
3465 test scan-1.6 {BuildCharSet, CharInSet} {
3466 list [scan -abc-def {%[ac-]} x] $x
3467 } {1 -a}
3468 test scan-1.7 {BuildCharSet, CharInSet} {
3469 list [scan abc-def {%[c-a]} x] $x
3470 } {1 abc}
3471 test scan-1.8 {BuildCharSet, CharInSet} {
3472 list [scan def-abc {%[^c-a]} x] $x
3473 } {1 def-}
3474 test scan-1.9 {BuildCharSet, CharInSet no match} {
3475 catch {unset x}
3476 list [scan {= f} {= %[TF]} x] [info exists x]
3477 } {0 0}
3479 test scan-2.1 {ReleaseCharSet} {
3480 list [scan abcde {%[abc]} x] $x
3481 } {1 abc}
3482 test scan-2.2 {ReleaseCharSet} {
3483 list [scan abcde {%[a-c]} x] $x
3484 } {1 abc}
3486 test scan-3.1 {ValidateFormat - mixing "%" and "%n$" conversion specifiers} {
3487 list [catch {scan {12 14} {%d%1$d}} msg] $msg
3488 } {1 {cannot mix "%" and "%n$" conversion specifiers}}
3489 test scan-3.2 {ValidateFormat - mixing "%" and "%n$" conversion specifiers} {
3490 list [catch {scan {} {%d%1$d}} msg] $msg
3491 } {1 {cannot mix "%" and "%n$" conversion specifiers}}
3492 test scan-3.3 {ValidateFormat - "%n$" argument index out of range} { #FIXME
3493 list [catch {scan {a} {%2$d%1$d} x}] [info exists x]
3494 } {1 1}
3495 test scan-3.4 {ValidateFormat} {
3496 # degenerate case, before changed from 8.2 to 8.3
3497 list [catch {scan {a} %d} msg] $msg
3498 } {0 {{}}}
3499 test scan-3.5 {ValidateFormat} {
3500 list [catch {scan {aaaaaaaaaa} {%10c} a} msg] $msg
3501 } {1 {field width may not be specified in %c conversion}}
3502 test scan-3.6 {ValidateFormat} {
3503 list [catch {scan {} {%*1$d} a} msg] $msg
3504 } {1 {bad scan conversion character}}
3505 test scan-3.7 {ValidateFormat} {
3506 list [catch {scan {} {%1$d%1$d} a} msg] $msg
3507 } {1 {same "%n$" conversion specifier used more than once}}
3508 test scan-3.8 {ValidateFormat} {
3509 list [catch {scan {} a x} msg] $msg
3510 } {1 {no any conversion specifier given}}
3511 test scan-3.9 {ValidateFormat} {
3512 list [catch {scan {} {%2$s} x} msg] $msg
3513 } {1 {"%n$" argument index out of range}}
3514 test scan-3.10 {ValidateFormat} {
3515 list [catch {scan {} {%[a} x} msg] $msg
3516 } {1 {unmatched [ in format string}}
3517 test scan-3.11 {ValidateFormat} {
3518 list [catch {scan {} {%[^a} x} msg] $msg
3519 } {1 {unmatched [ in format string}}
3520 test scan-3.12 {ValidateFormat} {
3521 list [catch {scan {} {%[]a} x} msg] $msg
3522 } {1 {unmatched [ in format string}}
3523 test scan-3.13 {ValidateFormat} {
3524 list [catch {scan {} {%[^]a} x} msg] $msg
3525 } {1 {unmatched [ in format string}}
3527 test scan-4.1 {Tcl_ScanObjCmd, argument checks} {
3528 list [catch {scan} msg] $msg
3529 } {1 {wrong # args: should be "scan string formatString ?varName ...?"}}
3530 test scan-4.2 {Tcl_ScanObjCmd, argument checks} {
3531 list [catch {scan string} msg] $msg
3532 } {1 {wrong # args: should be "scan string formatString ?varName ...?"}}
3533 test scan-4.3 {Tcl_ScanObjCmd, argument checks} {
3534 # degenerate case, before changed from 8.2 to 8.3
3535 list [catch {scan string format} msg] $msg
3536 } {1 {no any conversion specifier given}}
3537 test scan-4.4 {Tcl_ScanObjCmd, whitespace} {
3538 list [scan { abc def } {%s%s} x y] $x $y
3539 } {2 abc def}
3540 test scan-4.5 {Tcl_ScanObjCmd, whitespace} {
3541 list [scan { abc def } { %s %s } x y] $x $y
3542 } {2 abc def}
3543 test scan-4.6 {Tcl_ScanObjCmd, whitespace} {
3544 list [scan { abc def } { %s %s } x y] $x $y
3545 } {2 abc def}
3546 test scan-4.7 {Tcl_ScanObjCmd, literals} {
3547 # degenerate case, before changed from 8.2 to 8.3
3548 list [catch {scan { abc def } { abc def }} msg] $msg
3549 } {1 {no any conversion specifier given}}
3550 test scan-4.8 {Tcl_ScanObjCmd, literals} {
3551 set x {}
3552 list [scan { abcg} { abc def %1s} x] $x
3553 } {0 {}}
3554 test scan-4.9 {Tcl_ScanObjCmd, literals} {
3555 list [scan { abc%defghi} { abc %% def%n } x] $x
3556 } {1 10}
3557 test scan-4.10 {Tcl_ScanObjCmd, assignment suppression} {
3558 list [scan { abc def } { %*c%s def } x] $x
3559 } {1 bc}
3560 test scan-4.11 {Tcl_ScanObjCmd, XPG3-style} {
3561 list [scan { abc def } {%2$s %1$s} x y] $x $y
3562 } {2 def abc}
3563 test scan-4.12 {Tcl_ScanObjCmd, width specifiers} {
3564 list [scan {abc123456789012} {%3s%3d%3f%3[0-9]%s} a b c d e] $a $b $c $d $e
3565 } {5 abc 123 456.0 789 012}
3566 test scan-4.13 {Tcl_ScanObjCmd, width specifiers} {
3567 list [scan {abc123456789012} {%3s%3d%3f%3[0-9]%s} a b c d e] $a $b $c $d $e
3568 } {5 abc 123 456.0 789 012}
3569 test scan-4.14 {Tcl_ScanObjCmd, underflow} {
3570 set x {}
3571 list [scan {a} {a%d} x] $x
3572 } {-1 {}}
3573 test scan-4.15 {Tcl_ScanObjCmd, underflow} {
3574 set x {}
3575 list [scan {} {a%d} x] $x
3576 } {-1 {}}
3577 test scan-4.16 {Tcl_ScanObjCmd, underflow} {
3578 set x {}
3579 list [scan {ab} {a%d} x] $x
3580 } {0 {}}
3581 test scan-4.17 {Tcl_ScanObjCmd, underflow} {
3582 set x {}
3583 list [scan {a } {a%d} x] $x
3584 } {-1 {}}
3585 test scan-4.18 {Tcl_ScanObjCmd, skipping whitespace} {
3586 list [scan { b} {%c%s} x y] $x $y
3587 } {2 32 b}
3588 test scan-4.19 {Tcl_ScanObjCmd, skipping whitespace} {
3589 list [scan { b} {%[^b]%s} x y] $x $y
3590 } {2 { } b}
3591 test scan-4.20 {Tcl_ScanObjCmd, string scanning} {
3592 list [scan {abc def} {%s} x] $x
3593 } {1 abc}
3594 test scan-4.21 {Tcl_ScanObjCmd, string scanning} {
3595 list [scan {abc def} {%0s} x] $x
3596 } {1 abc}
3597 test scan-4.22 {Tcl_ScanObjCmd, string scanning} {
3598 list [scan {abc def} {%2s} x] $x
3599 } {1 ab}
3600 test scan-4.23 {Tcl_ScanObjCmd, string scanning} {
3601 list [scan {abc def} {%*s%n} x] $x
3602 } {1 3}
3603 test scan-4.24 {Tcl_ScanObjCmd, charset scanning} {
3604 list [scan {abcdef} {%[a-c]} x] $x
3605 } {1 abc}
3606 test scan-4.25 {Tcl_ScanObjCmd, charset scanning} {
3607 list [scan {abcdef} {%0[a-c]} x] $x
3608 } {1 abc}
3609 test scan-4.26 {Tcl_ScanObjCmd, charset scanning} {
3610 list [scan {abcdef} {%2[a-c]} x] $x
3611 } {1 ab}
3612 test scan-4.27 {Tcl_ScanObjCmd, charset scanning} {
3613 list [scan {abcdef} {%*[a-c]%n} x] $x
3614 } {1 3}
3615 test scan-4.28 {Tcl_ScanObjCmd, character scanning} {
3616 list [scan {abcdef} {%c} x] $x
3617 } {1 97}
3618 test scan-4.29 {Tcl_ScanObjCmd, character scanning} {
3619 list [scan {abcdef} {%*c%n} x] $x
3620 } {1 1}
3621 test scan-4.30 {Tcl_ScanObjCmd, base-10 integer scanning} {
3622 set x {}
3623 list [scan {1234567890a} {%3d} x] $x
3624 } {1 123}
3625 test scan-4.31 {Tcl_ScanObjCmd, base-10 integer scanning} {
3626 set x {}
3627 list [scan {1234567890a} {%d} x] $x
3628 } {1 1234567890}
3629 test scan-4.32 {Tcl_ScanObjCmd, base-10 integer scanning} {
3630 set x {}
3631 list [scan {01234567890a} {%d} x] $x
3632 } {1 1234567890}
3633 test scan-4.33 {Tcl_ScanObjCmd, base-10 integer scanning} {
3634 set x {}
3635 list [scan {+01234} {%d} x] $x
3636 } {1 1234}
3637 test scan-4.34 {Tcl_ScanObjCmd, base-10 integer scanning} {
3638 set x {}
3639 list [scan {-01234} {%d} x] $x
3640 } {1 -1234}
3641 test scan-4.35 {Tcl_ScanObjCmd, base-10 integer scanning} {
3642 set x {}
3643 list [scan {a01234} {%d} x] $x
3644 } {0 {}}
3645 test scan-4.36 {Tcl_ScanObjCmd, base-10 integer scanning} {
3646 set x {}
3647 list [scan {0x10} {%d} x] $x
3648 } {1 0}
3649 test scan-4.37 {Tcl_ScanObjCmd, base-8 integer scanning} {
3650 set x {}
3651 list [scan {012345678} {%o} x] $x
3652 } {1 342391}
3653 test scan-4.38 {Tcl_ScanObjCmd, base-8 integer scanning} {
3654 set x {}
3655 list [scan {+1238 -1239 123a} {%o%*s%o%*s%o} x y z] $x $y $z
3656 } {3 83 -83 83}
3657 test scan-4.39 {Tcl_ScanObjCmd, base-16 integer scanning} {
3658 set x {}
3659 list [scan {+1238 -123a 0123} {%x%x%x} x y z] $x $y $z
3660 } {3 4664 -4666 291}
3661 test scan-4.40 {Tcl_ScanObjCmd, base-16 integer scanning} {
3662 set x {}
3663 list [scan {aBcDeF AbCdEf 0x1} {%x%x%x} x y z] $x $y $z
3664 } {3 11259375 11259375 1}
3665 test scan-4.40.1 {Tcl_ScanObjCmd, base-16 integer scanning} {
3666 set x {}
3667 list [scan {0xF 0x00A0B 0X0XF} {%x %x %x} x y z] $x $y $z
3668 } {3 15 2571 0}
3669 test scan-4.40.2 {Tcl_ScanObjCmd, base-16 integer scanning} {
3670 catch {unset x}
3671 list [scan {xF} {%x} x] [info exists x]
3672 } {0 0}
3673 test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} {
3674 set x {}
3675 list [scan {10 010 0x10} {%i%i%i} x y z] $x $y $z
3676 } {3 10 8 16}
3677 test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} {
3678 set x {}
3679 list [scan {10 010 0X10} {%i%i%i} x y z] $x $y $z
3680 } {3 10 8 16}
3681 test scan-4.43 {Tcl_ScanObjCmd, integer scanning, odd cases} {
3682 set x {}
3683 list [scan {+ } {%i} x] $x
3684 } {0 {}}
3685 # Following test, Tcl will return {-1 {}}, but I do not understand why!
3686 # For me, its the same as 4.43
3687 test scan-4.44 {Tcl_ScanObjCmd, integer scanning, odd cases} {
3688 set x {}
3689 list [scan {+} {%i} x] $x
3690 } {0 {}}
3691 test scan-4.45 {Tcl_ScanObjCmd, integer scanning, odd cases} {
3692 set x {}
3693 list [scan {0x} {%i%s} x y] $x $y
3694 } {2 0 x}
3695 test scan-4.46 {Tcl_ScanObjCmd, integer scanning, odd cases} {
3696 set x {}
3697 list [scan {0X} {%i%s} x y] $x $y
3698 } {2 0 X}
3699 test scan-4.47 {Tcl_ScanObjCmd, integer scanning, suppressed} {
3700 set x {}
3701 list [scan {123def} {%*i%s} x] $x
3702 } {1 def}
3703 test scan-4.48 {Tcl_ScanObjCmd, float scanning} {
3704 list [scan {1 2 3} {%e %f %g} x y z] $x $y $z
3705 } {3 1.0 2.0 3.0}
3706 test scan-4.49 {Tcl_ScanObjCmd, float scanning} {
3707 list [scan {.1 0.2 3.} {%e %f %g} x y z] $x $y $z
3708 } {3 0.10000000000000001 0.20000000000000001 3.0}
3709 test scan-4.50 {Tcl_ScanObjCmd, float scanning} {
3710 list [scan {12345678a} %f x] $x
3711 } {1 12345678.0}
3712 test scan-4.51 {Tcl_ScanObjCmd, float scanning} {
3713 list [scan {+123+45} %f x] $x
3714 } {1 123.0}
3715 test scan-4.52 {Tcl_ScanObjCmd, float scanning} {
3716 list [scan {-123+45} %f x] $x
3717 } {1 -123.0}
3718 test scan-4.53 {Tcl_ScanObjCmd, float scanning} {
3719 list [scan {1.0e1} %f x] $x
3720 } {1 10.0}
3721 test scan-4.54 {Tcl_ScanObjCmd, float scanning} {
3722 list [scan {1.0e-1} %f x] $x
3723 } {1 0.10000000000000001}
3724 # This test is as strange as 4.44 so I changed the outcome
3725 test scan-4.55 {Tcl_ScanObjCmd, odd cases} {
3726 set x {}
3727 list [scan {+} %f x] $x
3728 } {0 {}}
3729 test scan-4.56 {Tcl_ScanObjCmd, odd cases} {
3730 set x {}
3731 list [scan {1.0e} %f%s x y] $x $y
3732 } {2 1.0 e}
3733 test scan-4.57 {Tcl_ScanObjCmd, odd cases} {
3734 set x {}
3735 list [scan {1.0e+} %f%s x y] $x $y
3736 } {2 1.0 e+}
3737 test scan-4.58 {Tcl_ScanObjCmd, odd cases} {
3738 set x {}
3739 set y {}
3740 list [scan {e1} %f%s x y] $x $y
3741 } {0 {} {}}
3742 test scan-4.59 {Tcl_ScanObjCmd, float scanning} {
3743 list [scan {1.0e-1x} %*f%n x] $x
3744 } {1 6}
3745 # TODO: Enable following tests, if [format] works properly
3746 # procedure that returns the range of integers
3747 #proc int_range {} {
3748 # for { set MIN_INT 1 } { $MIN_INT > 0 } {} {
3749 # set MIN_INT [expr { $MIN_INT << 1 }]
3751 # set MAX_INT [expr { ~ $MIN_INT }]
3752 # return [list $MIN_INT $MAX_INT]
3754 #test scan-4.62 {scanning of large and negative octal integers} {
3755 # foreach { MIN_INT MAX_INT } [int_range] {}
3756 # set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT]
3757 # list [scan $scanstring {%o %o %o} a b c] \
3758 # [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
3759 #} {3 1 1 1}
3760 #test scan-4.63 {scanning of large and negative hex integers} {
3761 # foreach { MIN_INT MAX_INT } [int_range] {}
3762 # set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT]
3763 # list [scan $scanstring {%x %x %x} a b c] \
3764 # [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
3765 #} {3 1 1 1}
3767 # clean up from last two tests
3769 #catch {
3770 # rename int_range {}
3773 test scan-5.1 {integer scanning} {
3774 set a {}; set b {}; set c {}; set d {}
3775 list [scan "-20 1476 \n33 0" "%d %d %d %d" a b c d] $a $b $c $d
3776 } {4 -20 1476 33 0}
3777 test scan-5.2 {integer scanning} {
3778 set a {}; set b {}; set c {}
3779 list [scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c] $a $b $c
3780 } {3 -4 16 7890}
3781 test scan-5.3 {integer scanning} {
3782 set a {}; set b {}; set c {}; set d {}
3783 list [scan "-45 16 +10 987" "%ld %d %ld %d" a b c d] $a $b $c $d
3784 } {4 -45 16 10 987}
3785 test scan-5.4 {integer scanning} {
3786 set a {}; set b {}; set c {}; set d {}
3787 list [scan "14 1ab 62 10" "%d %x %lo %x" a b c d] $a $b $c $d
3788 } {4 14 427 50 16}
3789 test scan-5.5 {integer scanning} {
3790 set a {}; set b {}; set c {}; set d {}
3791 list [scan "12345670 1234567890ab cdefg" "%o %o %x %lx" a b c d] \
3792 $a $b $c $d
3793 } {4 2739128 342391 561323 52719}
3794 test scan-5.6 {integer scanning} {
3795 set a {}; set b {}; set c {}; set d {}
3796 list [scan "ab123-24642" "%2x %3x %3o %2o" a b c d] $a $b $c $d
3797 } {4 171 291 -20 52}
3798 test scan-5.7 {integer scanning} {
3799 set a {}; set b {}
3800 list [scan "1234567 234 567 " "%*3x %x %*o %4o" a b] $a $b
3801 } {2 17767 375}
3802 test scan-5.8 {integer scanning} {
3803 set a {}; set b {}
3804 list [scan "a 1234" "%d %d" a b] $a $b
3805 } {0 {} {}}
3806 test scan-5.9 {integer scanning} {
3807 set a {}; set b {}; set c {}; set d {};
3808 list [scan "12345678" "%2d %2d %2ld %2d" a b c d] $a $b $c $d
3809 } {4 12 34 56 78}
3810 test scan-5.10 {integer scanning} {
3811 set a {}; set b {}; set c {}; set d {}
3812 list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d
3813 } {2 1 2 {} {}}
3814 test scan-5.12 {integer scanning} {
3815 set a {}; set b {}; set c {}
3816 list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \
3817 %ld,%lx,%lo a b c] $a $b $c
3818 } {3 7810179016327718216 7810179016327718216 7810179016327718216}
3820 test scan-6.1 {floating-point scanning} {
3821 set a {}; set b {}; set c {}; set d {}
3822 list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
3823 } {3 2.1000000000000001 -300000000.0 0.99961999999999995 {}}
3824 test scan-6.2 {floating-point scanning} {
3825 set a {}; set b {}; set c {}; set d {}
3826 list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] $a $b $c $d
3827 } {4 -1.0 234.0 5.0 8.1999999999999993}
3828 test scan-6.3 {floating-point scanning} {
3829 set a {}; set b {}; set c {}
3830 list [scan "1e00004 332E-4 3e+4" "%lf %*2e %f %f" a b c] $a $c
3831 } {3 10000.0 30000.0}
3832 #~ #
3833 #~ # Some libc implementations consider 3.e- bad input. The ANSI
3834 #~ # spec states that digits must follow the - sign.
3835 #~ #
3836 test scan-6.4 {floating-point scanning} {
3837 set a {}; set b {}; set c {}
3838 list [scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c] $a $b $c
3839 } {3 1.0 200.0 3.0}
3840 test scan-6.5 {floating-point scanning} {
3841 set a {}; set b {}; set c {}; set d {}
3842 list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d
3843 } {4 4.5999999999999996 99999.699999999997 87.643000000000001 118.0}
3844 test scan-6.6 {floating-point scanning} {
3845 set a {}; set b {}; set c {}; set d {}
3846 list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d
3847 } {4 1.2344999999999999 0.69699999999999995 124.0 5.0000000000000002e-05}
3848 test scan-6.7 {floating-point scanning} {
3849 set a {}; set b {}; set c {}; set d {}
3850 list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d
3851 } {1 4.5999999999999996 {} {} {}}
3852 test scan-6.8 {floating-point scanning} {
3853 set a {}; set b {}; set c {}; set d {}
3854 list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d
3855 } {2 4.5999999999999996 5.2000000000000002 {} {}}
3856 test scan-7.1 {string and character scanning} {
3857 set a {}; set b {}; set c {}; set d {}
3858 list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
3859 } {4 abc def ghijk dum}
3860 test scan-7.2 {string and character scanning} {
3861 set a {}; set b {}; set c {}; set d {}
3862 list [scan "a bcdef" "%c%c%1s %s" a b c d] $a $b $c $d
3863 } {4 97 32 b cdef}
3864 test scan-7.3 {string and character scanning} {
3865 set a {}; set b {}; set c {}
3866 list [scan "123456 test " "%*c%*s %s %s %s" a b c] $a $b $c
3867 } {1 test {} {}}
3868 test scan-7.4 {string and character scanning} {
3869 set a {}; set b {}; set c {}; set d
3870 list [scan "ababcd01234 f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d] $a $b $c $d
3871 } {4 abab cd {01234 } {f 12345}}
3872 test scan-7.5 {string and character scanning} {
3873 set a {}; set b {}; set c {}
3874 list [scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c
3875 } {3 aabc bcdefg 43}
3877 # FOLLOWING TESTS DISABLED DUE TO LACK OF UNICODE HANDLING
3879 #~ test scan-7.6 {string and character scanning, unicode} {
3880 #~ set a {}; set b {}; set c {}; set d {}
3881 #~ list [scan "abc d\u00c7fghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
3882 #~ } "4 abc d\u00c7f ghijk dum"
3883 #~ test scan-7.7 {string and character scanning, unicode} {
3884 #~ set a {}; set b {}
3885 #~ list [scan "ab\u00c7cdef" "ab%c%c" a b] $a $b
3886 #~ } "2 199 99"
3887 #~ test scan-7.8 {string and character scanning, unicode} {
3888 #~ set a {}; set b {}
3889 #~ list [scan "ab\ufeffdef" "%\[ab\ufeff\]" a] $a
3890 #~ } "1 ab\ufeff"
3892 test scan-8.1 {error conditions} {
3893 catch {scan a}
3895 test scan-8.2 {error conditions} {
3896 catch {scan a} msg
3897 set msg
3898 } {wrong # args: should be "scan string formatString ?varName ...?"}
3899 test scan-8.3 {error conditions} {
3900 list [catch {scan a %D x} msg] $msg
3901 } {1 {bad scan conversion character}}
3902 test scan-8.4 {error conditions} {
3903 list [catch {scan a %O x} msg] $msg
3904 } {1 {bad scan conversion character}}
3905 test scan-8.5 {error conditions} {
3906 list [catch {scan a %X x} msg] $msg
3907 } {1 {bad scan conversion character}}
3908 test scan-8.6 {error conditions} {
3909 list [catch {scan a %F x} msg] $msg
3910 } {1 {bad scan conversion character}}
3911 test scan-8.7 {error conditions} {
3912 list [catch {scan a %E x} msg] $msg
3913 } {1 {bad scan conversion character}}
3914 test scan-8.8 {error conditions} {
3915 list [catch {scan a "%d %d" a} msg] $msg
3916 } {1 {different numbers of variable names and field specifiers}}
3917 test scan-8.9 {error conditions} {
3918 list [catch {scan a "%d %d" a b c} msg] $msg
3919 } {1 {variable is not assigned by any conversion specifiers}}
3920 test scan-8.10 {error conditions} {
3921 set a {}; set b {}; set c {}; set d {}
3922 list [expr {[scan " a" " a %d %d %d %d" a b c d] <= 0}] $a $b $c $d
3923 } {1 {} {} {} {}}
3924 test scan-8.11 {error conditions} {
3925 set a {}; set b {}; set c {}; set d {}
3926 list [scan "1 2" "%d %d %d %d" a b c d] $a $b $c $d
3927 } {2 1 2 {} {}}
3928 test scan-8.12 {error conditions} {
3929 list [catch {scan 44 %2c a} msg] $msg
3930 } {1 {field width may not be specified in %c conversion}}
3931 test scan-8.13 {error conditions} {
3932 list [catch {scan abc {%[} x} msg] $msg
3933 } {1 {unmatched [ in format string}}
3934 test scan-8.14 {error conditions} {
3935 list [catch {scan abc {%[^a} x} msg] $msg
3936 } {1 {unmatched [ in format string}}
3937 test scan-8.15 {error conditions} {
3938 list [catch {scan abc {%[^]a} x} msg] $msg
3939 } {1 {unmatched [ in format string}}
3940 test scan-8.16 {error conditions} {
3941 list [catch {scan abc {%[]a} x} msg] $msg
3942 } {1 {unmatched [ in format string}}
3943 test scan-9.1 {lots of arguments} {
3944 scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
3945 } 20
3946 test scan-9.2 {lots of arguments} {
3947 scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
3948 set a20
3949 } 200
3950 test scan-10.1 {miscellaneous tests} {
3951 set a {}
3952 list [scan ab16c ab%dc a] $a
3953 } {1 16}
3954 test scan-10.2 {miscellaneous tests} {
3955 set a {}
3956 list [scan ax16c ab%dc a] $a
3957 } {0 {}}
3958 test scan-10.3 {miscellaneous tests} {
3959 set a {}
3960 list [catch {scan ab%c114 ab%%c%d a} msg] $msg $a
3961 } {0 1 114}
3962 test scan-10.4 {miscellaneous tests} {
3963 set a {}
3964 list [catch {scan ab%c14 ab%%c%d a} msg] $msg $a
3965 } {0 1 14}
3966 test scan-10.5 {miscellaneous tests} {
3967 catch {unset arr}
3968 set arr(2) {}
3969 list [catch {scan ab%c14 ab%%c%d arr(2)} msg] $msg $arr(2)
3970 } {0 1 14}
3971 test scan-11.1 {alignment in results array (TCL_ALIGN)} {
3972 scan "123 13.6" "%s %f" a b
3973 set b
3974 } 13.6
3975 test scan-11.2 {alignment in results array (TCL_ALIGN)} {
3976 scan "1234567 13.6" "%s %f" a b
3977 set b
3978 } 13.6
3979 test scan-11.3 {alignment in results array (TCL_ALIGN)} {
3980 scan "12345678901 13.6" "%s %f" a b
3981 set b
3982 } 13.6
3983 test scan-11.4 {alignment in results array (TCL_ALIGN)} {
3984 scan "123456789012345 13.6" "%s %f" a b
3985 set b
3986 } 13.6
3987 test scan-11.5 {alignment in results array (TCL_ALIGN)} {
3988 scan "1234567890123456789 13.6" "%s %f" a b
3989 set b
3990 } 13.6
3991 test scan-12.1 {Tcl_ScanObjCmd, inline case} {
3992 scan a %c
3993 } 97
3994 test scan-12.2 {Tcl_ScanObjCmd, inline case} {
3995 scan abc %c%c%c%c
3996 } {97 98 99 {}}
3997 test scan-12.3 {Tcl_ScanObjCmd, inline case} {
3998 scan abc %s%c
3999 } {abc {}}
4000 test scan-12.4 {Tcl_ScanObjCmd, inline case, underflow} {
4001 scan abc abc%c
4002 } {}
4003 test scan-12.5 {Tcl_ScanObjCmd, inline case} {
4004 scan abc bogus%c%c%c
4005 } {{} {} {}}
4007 # Expected result of following test was changed. Tcl expects {0 {}}, but
4008 # I feel a complain is correct, as no conversion ever can take place!
4010 test scan-12.6 {Tcl_ScanObjCmd, inline case} {
4011 # degenerate case, behavior changed from 8.2 to 8.3
4012 list [catch {scan foo foobar} msg] $msg
4013 } {1 {no any conversion specifier given}}
4014 test scan-12.7 {Tcl_ScanObjCmd, inline case lots of arguments} {
4015 scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140\
4016 150 160 170 180 190 200" \
4017 "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d"
4018 } {10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200 {}}
4019 test scan-13.1 {Tcl_ScanObjCmd, inline XPG case} {
4020 scan a {%1$c}
4021 } 97
4022 test scan-13.2 {Tcl_ScanObjCmd, inline XPG case} {
4023 scan abc {%1$c%2$c%3$c%4$c}
4024 } {97 98 99 {}}
4025 test scan-13.3 {Tcl_ScanObjCmd, inline XPG case} {
4026 list [catch {scan abc {%1$c%1$c}} msg] $msg
4027 } {1 {same "%n$" conversion specifier used more than once}}
4028 test scan-13.4 {Tcl_ScanObjCmd, inline XPG case} {
4029 scan abc {%2$s%1$c}
4030 } {{} abc}
4031 test scan-13.5 {Tcl_ScanObjCmd, inline XPG case, underflow} {
4032 list [catch {scan abc {abc%5$c}} msg] $msg
4033 } {0 {}}
4034 test scan-13.6 {Tcl_ScanObjCmd, inline XPG case} {
4035 catch {scan abc {bogus%1$c%5$c%10$c}} msg
4036 list [llength $msg] $msg
4037 } {10 {{} {} {} {} {} {} {} {} {} {}}}
4038 test scan-13.7 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
4039 scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" {%20$d %18$d %17$d %16$d %15$d %14$d %13$d %12$d %11$d %10$d %9$d %8$d %7$d %6$d %5$d %4$d %3$d %2$d %1$d}
4040 } {190 180 170 160 150 140 130 120 110 100 90 80 70 60 50 40 30 20 {} 10}
4041 test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
4042 set msg [scan "10 20 30" {%100$d %5$d %200$d}]
4043 list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199]
4044 } {200 10 20 30}
4046 ################################################################################
4047 # REGEXP and REGSUB
4048 ################################################################################
4050 catch {package require regexp}
4052 test regexp-1.1 {basic regexp operation} {
4053 regexp ab*c abbbc
4054 } {1}
4056 test regexp-1.2 {basic regexp operation} {
4057 regexp ab*c ac
4058 } {1}
4060 test regexp-1.3 {basic regexp operation} {
4061 regexp ab*c ab
4062 } {0}
4064 test regexp-1.4 {basic regexp operation} {
4065 regexp -- -gorp abc-gorpxxx
4066 } {1}
4068 test regexp-1.5 {basic regexp operation} {
4069 regexp {^([^ ]*)[ ]*([^ ]*)} "" a
4070 } {1}
4072 test regexp-1.6 {basic regexp operation} {
4073 list [catch {regexp {} abc} msg] $msg
4074 } {0 1}
4076 test regexp-2.1 {getting substrings back from regexp} {
4077 set foo {}
4078 list [regexp ab*c abbbbc foo] $foo
4079 } {1 abbbbc}
4081 test regexp-2.2 {getting substrings back from regexp} {
4082 set foo {}
4083 set f2 {}
4084 list [regexp a(b*)c abbbbc foo f2] $foo $f2
4085 } {1 abbbbc bbbb}
4087 test regexp-2.3 {getting substrings back from regexp} {
4088 set foo {}
4089 set f2 {}
4090 list [regexp a(b*)(c) abbbbc foo f2] $foo $f2
4091 } {1 abbbbc bbbb}
4093 test regexp-2.4 {getting substrings back from regexp} {
4094 set foo {}
4095 set f2 {}
4096 set f3 {}
4097 list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
4098 } {1 abbbbc bbbb c}
4100 test regexp-2.5 {getting substrings back from regexp} {
4101 set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
4102 set f6 {}; set f7 {}; set f8 {}; set f9 {}; set fa {}; set fb {};
4103 list [regexp (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*)(a*)(b*) \
4104 12223345556789999aabbb \
4105 foo f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb] $foo $f1 $f2 $f3 $f4 $f5 \
4106 $f6 $f7 $f8 $f9 $fa $fb
4107 } {1 12223345556789999aabbb 1 222 33 4 555 6 7 8 9999 aa bbb}
4109 test regexp-2.6 {getting substrings back from regexp} {
4110 set foo 2; set f2 2; set f3 2; set f4 2
4111 list [regexp (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
4112 } {1 a a {} {}}
4114 test regexp-2.7 {getting substrings back from regexp} {
4115 set foo 1; set f2 1; set f3 1; set f4 1
4116 list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
4117 } {1 ac a {} c}
4119 test regexp-2.8 {getting substrings back from regexp} {
4120 set match {}
4121 list [regexp {^a*b} aaaab match] $match
4122 } {1 aaaab}
4124 test regexp-3.1 {-indices option to regexp} {
4125 set foo {}
4126 list [regexp -indices ab*c abbbbc foo] $foo
4127 } {1 {0 5}}
4129 test regexp-3.2 {-indices option to regexp} {
4130 set foo {}
4131 set f2 {}
4132 list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2
4133 } {1 {0 5} {1 4}}
4135 test regexp-3.3 {-indices option to regexp} {
4136 set foo {}
4137 set f2 {}
4138 list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2
4139 } {1 {0 5} {1 4}}
4141 test regexp-3.4 {-indices option to regexp} {
4142 set foo {}
4143 set f2 {}
4144 set f3 {}
4145 list [regexp -indices a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
4146 } {1 {0 5} {1 4} {5 5}}
4148 test regexp-3.5 {-indices option to regexp} {
4149 set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
4150 set f6 {}; set f7 {}; set f8 {}; set f9 {}
4151 list [regexp -indices (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) \
4152 12223345556789999 \
4153 foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \
4154 $f6 $f7 $f8 $f9
4155 } {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}}
4157 test regexp-3.6 {getting substrings back from regexp} {
4158 set foo 2; set f2 2; set f3 2; set f4 2
4159 list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
4160 } {1 {1 1} {1 1} {-1 -1} {-1 -1}}
4162 test regexp-3.7 {getting substrings back from regexp} {
4163 set foo 1; set f2 1; set f3 1; set f4 1
4164 list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
4165 } {1 {1 2} {1 1} {-1 -1} {2 2}}
4167 test regexp-4.1 {-nocase option to regexp} {
4168 regexp -nocase foo abcFOo
4169 } {1}
4171 test regexp-4.2 {-nocase option to regexp} {
4172 set f1 22
4173 set f2 33
4174 set f3 44
4175 list [regexp -nocase {a(b*)([xy]*)z} aBbbxYXxxZ22 f1 f2 f3] $f1 $f2 $f3
4176 } {1 aBbbxYXxxZ Bbb xYXxx}
4178 test regexp-4.3 {-nocase option to regexp} {
4179 regexp -nocase FOo abcFOo
4180 } {1}
4182 test regexp-4.4 {case conversion in regexp} {
4183 set x abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890
4184 list [regexp -nocase $x $x foo] $foo
4185 } {1 abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890abcdefghijklmnopqrstuvwxyz1234567890}
4187 test regexp-5.1 {exercise cache of compiled expressions} {
4188 regexp .*a b
4189 regexp .*b c
4190 regexp .*c d
4191 regexp .*d e
4192 regexp .*e f
4193 regexp .*a bbba
4194 } {1}
4196 test regexp-5.2 {exercise cache of compiled expressions} {
4197 regexp .*a b
4198 regexp .*b c
4199 regexp .*c d
4200 regexp .*d e
4201 regexp .*e f
4202 regexp .*b xxxb
4203 } {1}
4205 test regexp-5.3 {exercise cache of compiled expressions} {
4206 regexp .*a b
4207 regexp .*b c
4208 regexp .*c d
4209 regexp .*d e
4210 regexp .*e f
4211 regexp .*c yyyc
4212 } {1}
4214 test regexp-5.4 {exercise cache of compiled expressions} {
4215 regexp .*a b
4216 regexp .*b c
4217 regexp .*c d
4218 regexp .*d e
4219 regexp .*e f
4220 regexp .*d 1d
4221 } {1}
4223 test regexp-5.5 {exercise cache of compiled expressions} {
4224 regexp .*a b
4225 regexp .*b c
4226 regexp .*c d
4227 regexp .*d e
4228 regexp .*e f
4229 regexp .*e xe
4230 } {1}
4232 test regexp-6.1 {regexp errors} {
4233 list [catch {regexp a} msg] $msg
4234 } {1 {wrong # args: should be "regexp ?-nocase? ?-line? ?-indices? ?-start offset? ?-all? ?-inline? exp string ?matchVar? ?subMatchVar ...?"}}
4236 test regexp-6.2 {regexp errors} {
4237 list [catch {regexp -nocase a} msg] $msg
4238 } {1 {wrong # args: should be "regexp ?-nocase? ?-line? ?-indices? ?-start offset? ?-all? ?-inline? exp string ?matchVar? ?subMatchVar ...?"}}
4240 test regexp-6.3 {regexp errors} {
4241 list [catch {regexp -gorp a} msg] $msg
4242 } {1 {wrong # args: should be "regexp ?-nocase? ?-line? ?-indices? ?-start offset? ?-all? ?-inline? exp string ?matchVar? ?subMatchVar ...?"}}
4244 test regexp-6.4 {regexp errors} {
4245 list [catch {regexp a( b} msg] $msg
4246 } {1 {couldn't compile regular expression pattern: parentheses not balanced}}
4248 test regexp-6.5 {regexp errors} {
4249 list [catch {regexp a( b} msg] $msg
4250 } {1 {couldn't compile regular expression pattern: parentheses not balanced}}
4252 test regexp-6.6 {regexp errors} {
4253 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
4254 } {0 1}
4256 test regexp-6.7 {regexp errors} {
4257 list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
4258 } {0 0}
4260 test regexp-6.8 {regexp errors} {
4261 catch {unset f1}
4262 set f1 44
4263 list [catch {regexp abc abc f1(f2)} msg] $msg
4264 } {1 {couldn't set variable "f1(f2)"}}
4266 test regexp-6.9 {regexp errors, -start bad int check} {
4267 list [catch {regexp -start bogus {^$} {}} msg] $msg
4268 } {1 {expected integer but got "bogus"}}
4270 test regexp-7.1 {basic regsub operation} {
4271 list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
4272 } {1 xax111aaa222xaa}
4274 test regexp-7.2 {basic regsub operation} {
4275 list [regsub aa+ aaaxaa &111 foo] $foo
4276 } {1 aaa111xaa}
4278 test regexp-7.3 {basic regsub operation} {
4279 list [regsub aa+ xaxaaa 111& foo] $foo
4280 } {1 xax111aaa}
4282 test regexp-7.4 {basic regsub operation} {
4283 list [regsub aa+ aaa 11&2&333 foo] $foo
4284 } {1 11aaa2aaa333}
4286 test regexp-7.5 {basic regsub operation} {
4287 list [regsub aa+ xaxaaaxaa &2&333 foo] $foo
4288 } {1 xaxaaa2aaa333xaa}
4290 test regexp-7.6 {basic regsub operation} {
4291 list [regsub aa+ xaxaaaxaa 1&22& foo] $foo
4292 } {1 xax1aaa22aaaxaa}
4294 test regexp-7.7 {basic regsub operation} {
4295 list [regsub a(a+) xaxaaaxaa {1\122\1} foo] $foo
4296 } {1 xax1aa22aaxaa}
4298 test regexp-7.8 {basic regsub operation} {
4299 list [regsub a(a+) xaxaaaxaa {1\\\122\1} foo] $foo
4300 } {1 {xax1\aa22aaxaa}}
4302 test regexp-7.9 {basic regsub operation} {
4303 list [regsub a(a+) xaxaaaxaa {1\\122\1} foo] $foo
4304 } {1 {xax1\122aaxaa}}
4306 test regexp-7.10 {basic regsub operation} {
4307 list [regsub a(a+) xaxaaaxaa {1\\&\1} foo] $foo
4308 } {1 {xax1\aaaaaxaa}}
4310 test regexp-7.11 {basic regsub operation} {
4311 list [regsub a(a+) xaxaaaxaa {1\&\1} foo] $foo
4312 } {1 xax1&aaxaa}
4314 test regexp-7.12 {basic regsub operation} {
4315 list [regsub a(a+) xaxaaaxaa {\1\1\1\1&&} foo] $foo
4316 } {1 xaxaaaaaaaaaaaaaaxaa}
4318 test regexp-7.13 {basic regsub operation} {
4319 set foo xxx
4320 list [regsub abc xyz 111 foo] $foo
4321 } {0 xyz}
4323 test regexp-7.14 {basic regsub operation} {
4324 set foo xxx
4325 list [regsub ^ xyz "111 " foo] $foo
4326 } {1 {111 xyz}}
4328 test regexp-7.15 {basic regsub operation} {
4329 set foo xxx
4330 list [regsub -- -foo abc-foodef "111 " foo] $foo
4331 } {1 {abc111 def}}
4333 test regexp-7.16 {basic regsub operation} {
4334 set foo xxx
4335 list [regsub x "" y foo] $foo
4336 } {0 {}}
4338 test regexp-8.1 {case conversion in regsub} {
4339 list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
4340 } {1 xaAAaAAay}
4342 test regexp-8.2 {case conversion in regsub} {
4343 list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
4344 } {1 xaAAaAAay}
4346 test regexp-8.3 {case conversion in regsub} {
4347 set foo 123
4348 list [regsub a(a+) xaAAaAAay & foo] $foo
4349 } {0 xaAAaAAay}
4351 test regexp-8.4 {case conversion in regsub} {
4352 set foo 123
4353 list [regsub -nocase a CaDE b foo] $foo
4354 } {1 CbDE}
4356 test regexp-8.5 {case conversion in regsub} {
4357 set foo 123
4358 list [regsub -nocase XYZ CxYzD b foo] $foo
4359 } {1 CbD}
4361 test regexp-8.6 {case conversion in regsub} {
4362 set x abcdefghijklmnopqrstuvwxyz1234567890
4363 set x $x$x$x$x$x$x$x$x$x$x$x$x
4364 set foo 123
4365 list [regsub -nocase $x $x b foo] $foo
4366 } {1 b}
4368 test regexp-9.1 {-all option to regsub} {
4369 set foo 86
4370 list [regsub -all x+ axxxbxxcxdx |&| foo] $foo
4371 } {4 a|xxx|b|xx|c|x|d|x|}
4373 test regexp-9.2 {-all option to regsub} {
4374 set foo 86
4375 list [regsub -nocase -all x+ aXxXbxxcXdx |&| foo] $foo
4376 } {4 a|XxX|b|xx|c|X|d|x|}
4378 test regexp-9.3 {-all option to regsub} {
4379 set foo 86
4380 list [regsub x+ axxxbxxcxdx |&| foo] $foo
4381 } {1 a|xxx|bxxcxdx}
4383 test regexp-9.4 {-all option to regsub} {
4384 set foo 86
4385 list [regsub -all bc axxxbxxcxdx |&| foo] $foo
4386 } {0 axxxbxxcxdx}
4388 test regexp-9.5 {-all option to regsub} {
4389 set foo xxx
4390 list [regsub -all node "node node more" yy foo] $foo
4391 } {2 {yy yy more}}
4393 test regexp-9.6 {-all option to regsub} {
4394 set foo xxx
4395 list [regsub -all ^ xxx 123 foo] $foo
4396 } {1 123xxx}
4398 test regexp-10.2 {newline sensitivity in regsub} {
4399 set foo xxx
4400 list [regsub -line {^a.*b$} "dabc\naxyb\n" 123 foo] $foo
4401 } {1 {dabc
4405 test regexp-10.3 {newline sensitivity in regsub} {
4406 set foo xxx
4407 list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo
4408 } {1 {dabc
4410 xb}}
4412 test regexp-11.1 {regsub errors} {
4413 list [catch {regsub a b c} msg] $msg
4414 } {1 {wrong # args: should be "regsub ?-nocase? ?-all? exp string subSpec varName"}}
4416 test regexp-11.2 {regsub errors} {
4417 list [catch {regsub -nocase a b c} msg] $msg
4418 } {1 {wrong # args: should be "regsub ?-nocase? ?-all? exp string subSpec varName"}}
4420 test regexp-11.3 {regsub errors} {
4421 list [catch {regsub -nocase -all a b c} msg] $msg
4422 } {1 {wrong # args: should be "regsub ?-nocase? ?-all? exp string subSpec varName"}}
4424 test regexp-11.4 {regsub errors} {
4425 list [catch {regsub a b c d e f} msg] $msg
4426 } {1 {wrong # args: should be "regsub ?-nocase? ?-all? exp string subSpec varName"}}
4428 test regexp-11.5 {regsub errors} {
4429 list [catch {regsub -gorp a b c} msg] $msg
4430 } {1 {wrong # args: should be "regsub ?-nocase? ?-all? exp string subSpec varName"}}
4432 test regexp-11.6 {regsub errors} {
4433 list [catch {regsub -nocase a( b c d} msg] $msg
4434 } {1 {couldn't compile regular expression pattern: parentheses not balanced}}
4436 test regexp-11.7 {regsub errors} {
4437 catch {unset f1}
4438 set f1 44
4439 list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
4440 } {1 {couldn't set variable "f1(f2)"}}
4442 test regexp-11.8 {regsub errors, -start bad int check} {
4443 list [catch {regsub -start bogus pattern string rep var} msg] $msg
4444 } {1 {expected integer but got "bogus"}}
4446 test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {
4447 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
4448 } {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}
4450 test regexp-13.1 {regsub of a very large string} {
4451 # This test is designed to stress the memory subsystem in order
4452 # to catch Bug #933. It only fails if the Tcl memory allocator
4453 # is in use.
4455 set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE}
4456 set filedata [string repeat $line 200]
4457 for {set i 1} {$i<10} {incr i} {
4458 regsub -all "BEGIN_TABLE " $filedata "" newfiledata
4460 set x done
4461 } {done}
4463 test regexp-14.1 {CompileRegexp: regexp cache} {
4464 regexp .*a b
4465 regexp .*b c
4466 regexp .*c d
4467 regexp .*d e
4468 regexp .*e f
4469 set x .
4470 append x *a
4471 regexp $x bbba
4472 } {1}
4474 test regexp-14.2 {CompileRegexp: regexp cache, different flags} {
4475 regexp .*a b
4476 regexp .*b c
4477 regexp .*c d
4478 regexp .*d e
4479 regexp .*e f
4480 set x .
4481 append x *a
4482 regexp -nocase $x bbba
4483 } {1}
4485 test regexp-15.1 {regexp -start} {
4486 catch {unset x}
4487 list [regexp -start -10 {[0-9]} 1abc2de3 x] $x
4488 } {1 1}
4490 test regexp-15.2 {regexp -start} {
4491 catch {unset x}
4492 list [regexp -start 2 {[0-9]} 1abc2de3 x] $x
4493 } {1 2}
4495 test regexp-15.3 {regexp -start} {
4496 catch {unset x}
4497 list [regexp -start 4 {[0-9]} 1abc2de3 x] $x
4498 } {1 2}
4500 test regexp-15.4 {regexp -start} {
4501 catch {unset x}
4502 list [regexp -start 5 {[0-9]} 1abc2de3 x] $x
4503 } {1 3}
4505 test regexp-15.5 {regexp -start, over end of string} {
4506 catch {unset x}
4507 list [regexp -start [string length 1abc2de3] {[0-9]} 1abc2de3 x] [info exists x]
4508 } {0 0}
4510 test regexp-15.6 {regexp -start, loss of ^$ behavior} {
4511 list [regexp -start 2 {^$} {}]
4512 } {1}
4514 test regexp-16.1 {regsub -start} {
4515 catch {unset x}
4516 list [regsub -all -start 2 {[0-9]} a1b2c3d4e5 {/&} x] $x
4517 } {4 a1b/2c/3d/4e/5}
4519 test regexp-16.2 {regsub -start} {
4520 catch {unset x}
4521 list [regsub -all -start -25 {z} hello {/&} x] $x
4522 } {0 hello}
4524 test regexp-16.3 {regsub -start} {
4525 catch {unset x}
4526 list [regsub -all -start 3 {z} hello {/&} x] $x
4527 } {0 hello}
4529 test regexp-17.1 {regexp -inline} {
4530 regexp -inline b ababa
4531 } {b}
4533 test regexp-17.2 {regexp -inline} {
4534 regexp -inline (b) ababa
4535 } {b b}
4537 test regexp-17.3 {regexp -inline -indices} {
4538 regexp -inline -indices (b) ababa
4539 } {{1 1} {1 1}}
4541 test regexp-17.4 {regexp -inline} {
4542 regexp -inline {[[:alnum:]_]([0-9]+)[[:alnum:]_]} " hello 23 there456def "
4543 } {e456d 456}
4545 test regexp-17.5 {regexp -inline no matches} {
4546 regexp -inline {[[:alnum:]_]([0-9]+)[[:alnum:]_]} ""
4547 } {}
4549 test regexp-17.6 {regexp -inline no matches} {
4550 regexp -inline hello goodbye
4551 } {}
4553 test regexp-17.7 {regexp -inline, no matchvars allowed} {
4554 list [catch {regexp -inline b abc match} msg] $msg
4555 } {1 {regexp match variables not allowed when using -inline}}
4557 test regexp-18.1 {regexp -all} {
4558 regexp -all b bbbbb
4559 } {5}
4561 test regexp-18.2 {regexp -all} {
4562 regexp -all b abababbabaaaaaaaaaab
4563 } {6}
4565 test regexp-18.3 {regexp -all -inline} {
4566 regexp -all -inline b abababbabaaaaaaaaaab
4567 } {b b b b b b}
4569 test regexp-18.4 {regexp -all -inline} {
4570 regexp -all -inline {[[:alnum:]_]([[:alnum:]_])} abcdefg
4571 } {ab b cd d ef f}
4573 test regexp-18.5 {regexp -all -inline} {
4574 regexp -all -inline {[[:alnum:]_]([[:alnum:]_])$} abcdefg
4575 } {fg g}
4577 test regexp-18.6 {regexp -all -inline} {
4578 regexp -all -inline {[0-9]+} 10:20:30:40
4579 } {10 20 30 40}
4581 test regexp-18.7 {regexp -all -inline} {
4582 list [catch {regexp -all -inline b abc match} msg] $msg
4583 } {1 {regexp match variables not allowed when using -inline}}
4585 test regexp-18.8 {regexp -all} {
4586 # This should not cause an infinite loop
4587 regexp -all -inline {a*} a
4588 } {a}
4590 test regexp-18.9 {regexp -all} {
4591 # Yes, the expected result is {a {}}. Here's why:
4592 # Start at index 0; a* matches the "a" there then stops.
4593 # Go to index 1; a* matches the lambda (or {}) there then stops. Recall
4594 # that a* matches zero or more "a"'s; thus it matches the string "b", as
4595 # there are zero or more "a"'s there.
4596 # Go to index 2; this is past the end of the string, so stop.
4597 regexp -all -inline {a*} ab
4598 } {a {}}
4600 test regexp-18.10 {regexp -all} {
4601 # Yes, the expected result is {a {} a}. Here's why:
4602 # Start at index 0; a* matches the "a" there then stops.
4603 # Go to index 1; a* matches the lambda (or {}) there then stops. Recall
4604 # that a* matches zero or more "a"'s; thus it matches the string "b", as
4605 # there are zero or more "a"'s there.
4606 # Go to index 2; a* matches the "a" there then stops.
4607 # Go to index 3; this is past the end of the string, so stop.
4608 regexp -all -inline {a*} aba
4609 } {a {} a}
4611 test regexp-18.11 {regexp -all} {
4612 regexp -all -inline {^a} aaaa
4613 } {a}
4615 test regexp-19.1 {regsub null replacement} {
4616 regsub -all {@} {@hel@lo@} "\0a\0" result
4617 list $result [string length $result]
4618 } {hello 5}
4621 ################################################################################
4622 # RANGE
4623 ################################################################################
4625 test range-1.1 {basic range tests} {
4626 range 0 10
4627 } {0 1 2 3 4 5 6 7 8 9}
4629 test range-1.2 {basic range tests} {
4630 range 10 0 -1
4631 } {10 9 8 7 6 5 4 3 2 1}
4633 test range-1.3 {basic range tests} {
4634 range 1 10 11
4635 } {1}
4637 test range-1.4 {basic range tests} {
4638 range 1 10 11
4639 } {1}
4641 test range-1.5 {basic range tests} {
4642 range 10 10
4643 } {}
4645 test range-1.6 {basic range tests} {
4646 range 10 10 2
4647 } {}
4649 test range-1.7 {basic range test} {
4650 range 5
4651 } {0 1 2 3 4}
4653 test range-1.8 {basic range test} {
4654 range -10 -20 -2
4655 } {-10 -12 -14 -16 -18}
4657 test range-1.9 {basic range test} {
4658 range -20 -10 3
4659 } {-20 -17 -14 -11}
4661 test range-2.0 {foreach range test} {
4662 set k 0
4663 foreach {x y} [range 100] {
4664 incr k [expr {$x*$y}]
4666 set k
4667 } {164150}
4669 test range-2.1 {foreach range test without obj reuse} {
4670 set k 0
4671 set trash {}
4672 foreach {x y} [range 100] {
4673 incr k [expr {$x*$y}]
4674 lappend trash $x $y
4676 set trash {}
4677 set k
4678 } {164150}
4680 test range-2.2 {range element shimmering test} {
4681 set k {}
4682 foreach x [range 0 10] {
4683 append k [llength $x]
4685 set k
4686 } {1111111111}
4688 test range-3.0 {llength range test} {
4689 llength [range 5000]
4690 } {5000}
4692 test range-3.1 {llength range test} {
4693 llength [range 5000 5000]
4694 } {0}
4696 test range-4.0 {lindex range test} {
4697 lindex [range 1000] 500
4698 } {500}
4700 test range-4.1 {lindex range test} {
4701 lindex [range 1000] end-2
4702 } {997}
4704 test range-5.0 {lindex llength range test} {
4705 set k 0
4706 set trash {}
4707 set r [range 100]
4708 for {set i 0} {$i < [llength $r]} {incr i 2} {
4709 incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}]
4711 set trash {}
4712 set k
4713 } {164150}
4715 ################################################################################
4716 # SCOPE
4717 ################################################################################
4718 if 0 {
4719 test scope-1.0 {Non existing var} {
4720 catch {unset x}
4721 scope x {
4722 set x 10
4723 set y [+ $x 1]
4725 list [info exists x] $y
4726 } {0 11}
4728 test scope-1.1 {Existing var restore} {
4729 set x 100
4730 scope x {
4731 for {set x 0} {$x < 10} {incr x} {}
4733 set x
4734 } {100}
4736 test scope-1.2 {Mix of 1.0 and 1.1 tests} {
4737 catch {unset x}
4738 set y 10
4739 scope {x y} {
4740 set y 100
4741 set x 200
4743 list [info exists x] $y
4744 } {0 10}
4746 test scope-1.3 {Array element} {
4747 set x "a 1 b 2"
4748 scope x(a) {
4749 set x(a) Hello!
4751 set x(a)
4752 } {1}
4754 test scope-1.4 {Non existing array element} {
4755 catch {unset x}
4756 scope x(a) {
4757 set x(a) Hello!
4759 info exists x(a)
4760 } {0}
4762 test scope-1.5 {Info exists} {
4763 set x foo
4764 scope x {
4765 info exists x
4767 } {0}
4769 catch {unset x}
4770 catch {unset y}
4773 ################################################################################
4774 # RAND
4775 ################################################################################
4776 test rand-1.0 {Only one output is valid} {
4777 list [rand 100 100] [rand 101 101]
4778 } {100 101}
4780 test rand-1.1 {invalid arguments} {
4781 catch {rand 100 50} err
4782 set err
4783 } {Invalid arguments (max < min)}
4785 test rand-1.2 {Check limits} {
4786 set sum 0
4787 for {set i 0} {$i < 100} {incr i} {
4788 incr sum [expr {([rand $i] >= 0)+([rand $i] < 100)}]
4790 set sum
4791 } {200}
4793 catch {unset sum; unset err; unset i}
4795 ################################################################################
4796 # JIM REGRESSION TESTS
4797 ################################################################################
4798 test regression-1.0 {Rename against procedures with static vars} {
4799 proc foobar {x} {{y 10}} {
4800 incr y $x
4802 foobar 30
4803 foobar 20
4804 rename foobar barfoo
4805 list [barfoo 1] [barfoo 2] [barfoo 3]
4806 } {61 63 66}
4808 rename barfoo {}
4810 test regression-1.1 {lrange bug with negative indexes of type int} {
4811 lrange {a b c} 0 [- 0 1]
4812 } {}
4814 ################################################################################
4815 # FINAL REPORT
4816 ################################################################################
4818 puts "----------------------------------------------------------------------"
4819 puts "FAILED: $failedTests"
4820 foreach testId $failedList {
4821 puts "\t$testId"
4823 puts "PASSED: $passedTests"
4824 puts "----------------------------------------------------------------------\n"