1 | # Commands covered: switch |
---|
2 | # |
---|
3 | # This file contains a collection of tests for one or more of the Tcl |
---|
4 | # built-in commands. Sourcing this file into Tcl runs the tests and |
---|
5 | # generates output for errors. No output means no errors were found. |
---|
6 | # |
---|
7 | # Copyright (c) 1993 The Regents of the University of California. |
---|
8 | # Copyright (c) 1994 Sun Microsystems, Inc. |
---|
9 | # Copyright (c) 1998-1999 by Scriptics Corporation. |
---|
10 | # |
---|
11 | # See the file "license.terms" for information on usage and redistribution |
---|
12 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
13 | # |
---|
14 | # RCS: @(#) $Id: switch.test,v 1.21 2008/03/21 19:09:13 dkf Exp $ |
---|
15 | |
---|
16 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
17 | package require tcltest 2 |
---|
18 | namespace import -force ::tcltest::* |
---|
19 | } |
---|
20 | |
---|
21 | test switch-1.1 {simple patterns} { |
---|
22 | switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4} |
---|
23 | } 1 |
---|
24 | test switch-1.2 {simple patterns} { |
---|
25 | switch b a {subst 1} b {subst 2} c {subst 3} default {subst 4} |
---|
26 | } 2 |
---|
27 | test switch-1.3 {simple patterns} { |
---|
28 | switch x a {subst 1} b {subst 2} c {subst 3} default {subst 4} |
---|
29 | } 4 |
---|
30 | test switch-1.4 {simple patterns} { |
---|
31 | switch x a {subst 1} b {subst 2} c {subst 3} |
---|
32 | } {} |
---|
33 | test switch-1.5 {simple pattern matches many times} { |
---|
34 | switch b a {subst 1} b {subst 2} b {subst 3} b {subst 4} |
---|
35 | } 2 |
---|
36 | test switch-1.6 {simple patterns} { |
---|
37 | switch default a {subst 1} default {subst 2} c {subst 3} default {subst 4} |
---|
38 | } 2 |
---|
39 | test switch-1.7 {simple patterns} { |
---|
40 | switch x a {subst 1} default {subst 2} c {subst 3} default {subst 4} |
---|
41 | } 4 |
---|
42 | test switch-1.8 {simple patterns with -nocase} { |
---|
43 | switch -nocase b a {subst 1} b {subst 2} c {subst 3} default {subst 4} |
---|
44 | } 2 |
---|
45 | test switch-1.9 {simple patterns with -nocase} { |
---|
46 | switch -nocase B a {subst 1} b {subst 2} c {subst 3} default {subst 4} |
---|
47 | } 2 |
---|
48 | test switch-1.10 {simple patterns with -nocase} { |
---|
49 | switch -nocase b a {subst 1} B {subst 2} c {subst 3} default {subst 4} |
---|
50 | } 2 |
---|
51 | test switch-1.11 {simple patterns with -nocase} { |
---|
52 | switch -nocase x a {subst 1} default {subst 2} c {subst 3} default {subst 4} |
---|
53 | } 4 |
---|
54 | |
---|
55 | test switch-2.1 {single-argument form for pattern/command pairs} { |
---|
56 | switch b { |
---|
57 | a {subst 1} |
---|
58 | b {subst 2} |
---|
59 | default {subst 6} |
---|
60 | } |
---|
61 | } {2} |
---|
62 | test switch-2.2 {single-argument form for pattern/command pairs} -body { |
---|
63 | switch z {a 2 b} |
---|
64 | } -returnCodes error -result {extra switch pattern with no body} |
---|
65 | |
---|
66 | test switch-3.1 {-exact vs. -glob vs. -regexp} { |
---|
67 | switch -exact aaaab { |
---|
68 | ^a*b$ {subst regexp} |
---|
69 | *b {subst glob} |
---|
70 | aaaab {subst exact} |
---|
71 | default {subst none} |
---|
72 | } |
---|
73 | } exact |
---|
74 | test switch-3.2 {-exact vs. -glob vs. -regexp} { |
---|
75 | switch -regexp aaaab { |
---|
76 | ^a*b$ {subst regexp} |
---|
77 | *b {subst glob} |
---|
78 | aaaab {subst exact} |
---|
79 | default {subst none} |
---|
80 | } |
---|
81 | } regexp |
---|
82 | test switch-3.3 {-exact vs. -glob vs. -regexp} { |
---|
83 | switch -glob aaaab { |
---|
84 | ^a*b$ {subst regexp} |
---|
85 | *b {subst glob} |
---|
86 | aaaab {subst exact} |
---|
87 | default {subst none} |
---|
88 | } |
---|
89 | } glob |
---|
90 | test switch-3.4 {-exact vs. -glob vs. -regexp} { |
---|
91 | switch aaaab {^a*b$} {subst regexp} *b {subst glob} \ |
---|
92 | aaaab {subst exact} default {subst none} |
---|
93 | } exact |
---|
94 | test switch-3.5 {-exact vs. -glob vs. -regexp} { |
---|
95 | switch -- -glob { |
---|
96 | ^g.*b$ {subst regexp} |
---|
97 | -* {subst glob} |
---|
98 | -glob {subst exact} |
---|
99 | default {subst none} |
---|
100 | } |
---|
101 | } exact |
---|
102 | test switch-3.6 {-exact vs. -glob vs. -regexp} -body { |
---|
103 | switch -foo a b c |
---|
104 | } -returnCodes error -result {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -nocase, -regexp, or --} |
---|
105 | test switch-3.7 {-exact vs. -glob vs. -regexp with -nocase} { |
---|
106 | switch -exact -nocase aaaab { |
---|
107 | ^a*b$ {subst regexp} |
---|
108 | *b {subst glob} |
---|
109 | aaaab {subst exact} |
---|
110 | default {subst none} |
---|
111 | } |
---|
112 | } exact |
---|
113 | test switch-3.8 {-exact vs. -glob vs. -regexp with -nocase} { |
---|
114 | switch -regexp -nocase aaaab { |
---|
115 | ^a*b$ {subst regexp} |
---|
116 | *b {subst glob} |
---|
117 | aaaab {subst exact} |
---|
118 | default {subst none} |
---|
119 | } |
---|
120 | } regexp |
---|
121 | test switch-3.9 {-exact vs. -glob vs. -regexp with -nocase} { |
---|
122 | switch -glob -nocase aaaab { |
---|
123 | ^a*b$ {subst regexp} |
---|
124 | *b {subst glob} |
---|
125 | aaaab {subst exact} |
---|
126 | default {subst none} |
---|
127 | } |
---|
128 | } glob |
---|
129 | test switch-3.10 {-exact vs. -glob vs. -regexp with -nocase} { |
---|
130 | switch -nocase aaaab {^a*b$} {subst regexp} *b {subst glob} \ |
---|
131 | aaaab {subst exact} default {subst none} |
---|
132 | } exact |
---|
133 | test switch-3.11 {-exact vs. -glob vs. -regexp with -nocase} { |
---|
134 | switch -nocase -- -glob { |
---|
135 | ^g.*b$ {subst regexp} |
---|
136 | -* {subst glob} |
---|
137 | -glob {subst exact} |
---|
138 | default {subst none} |
---|
139 | } |
---|
140 | } exact |
---|
141 | test switch-3.12 {-exact vs. -glob vs. -regexp} { |
---|
142 | switch -exa Foo Foo {set result OK} |
---|
143 | } OK |
---|
144 | test switch-3.13 {-exact vs. -glob vs. -regexp} { |
---|
145 | switch -gl Foo Fo? {set result OK} |
---|
146 | } OK |
---|
147 | test switch-3.14 {-exact vs. -glob vs. -regexp} { |
---|
148 | switch -re Foo Fo. {set result OK} |
---|
149 | } OK |
---|
150 | test switch-3.15 {-exact vs. -glob vs. -regexp} -body { |
---|
151 | switch -exact -exact Foo Foo {set result OK} |
---|
152 | } -returnCodes error -result {bad option "-exact": -exact option already found} |
---|
153 | test switch-3.16 {-exact vs. -glob vs. -regexp} -body { |
---|
154 | switch -exact -glob Foo Foo {set result OK} |
---|
155 | } -returnCodes error -result {bad option "-glob": -exact option already found} |
---|
156 | test switch-3.17 {-exact vs. -glob vs. -regexp} -body { |
---|
157 | switch -glob -regexp Foo Foo {set result OK} |
---|
158 | } -returnCodes error -result {bad option "-regexp": -glob option already found} |
---|
159 | test switch-3.18 {-exact vs. -glob vs. -regexp} -body { |
---|
160 | switch -regexp -glob Foo Foo {set result OK} |
---|
161 | } -returnCodes error -result {bad option "-glob": -regexp option already found} |
---|
162 | |
---|
163 | test switch-4.1 {error in executed command} { |
---|
164 | list [catch {switch a a {error "Just a test"} default {subst 1}} msg] \ |
---|
165 | $msg $::errorInfo |
---|
166 | } {1 {Just a test} {Just a test |
---|
167 | while executing |
---|
168 | "error "Just a test"" |
---|
169 | ("a" arm line 1) |
---|
170 | invoked from within |
---|
171 | "switch a a {error "Just a test"} default {subst 1}"}} |
---|
172 | test switch-4.2 {error: not enough args} -returnCodes error -body { |
---|
173 | switch |
---|
174 | } -result {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"} |
---|
175 | test switch-4.3 {error: pattern with no body} -body { |
---|
176 | switch a b |
---|
177 | } -returnCodes error -result {extra switch pattern with no body} |
---|
178 | test switch-4.4 {error: pattern with no body} -body { |
---|
179 | switch a b {subst 1} c |
---|
180 | } -returnCodes error -result {extra switch pattern with no body} |
---|
181 | test switch-4.5 {error in default command} { |
---|
182 | list [catch {switch foo a {error switch1} b {error switch 3} \ |
---|
183 | default {error switch2}} msg] $msg $::errorInfo |
---|
184 | } {1 switch2 {switch2 |
---|
185 | while executing |
---|
186 | "error switch2" |
---|
187 | ("default" arm line 1) |
---|
188 | invoked from within |
---|
189 | "switch foo a {error switch1} b {error switch 3} default {error switch2}"}} |
---|
190 | |
---|
191 | test switch-5.1 {errors in -regexp matching} -returnCodes error -body { |
---|
192 | switch -regexp aaaab { |
---|
193 | *b {subst glob} |
---|
194 | aaaab {subst exact} |
---|
195 | default {subst none} |
---|
196 | } |
---|
197 | } -result {couldn't compile regular expression pattern: quantifier operand invalid} |
---|
198 | |
---|
199 | test switch-6.1 {backslashes in patterns} { |
---|
200 | switch -exact {\a\$\.\[} { |
---|
201 | \a\$\.\[ {subst first} |
---|
202 | \a\\$\.\\[ {subst second} |
---|
203 | \\a\\$\\.\\[ {subst third} |
---|
204 | {\a\\$\.\\[} {subst fourth} |
---|
205 | {\\a\\$\\.\\[} {subst fifth} |
---|
206 | default {subst none} |
---|
207 | } |
---|
208 | } third |
---|
209 | test switch-6.2 {backslashes in patterns} { |
---|
210 | switch -exact {\a\$\.\[} { |
---|
211 | \a\$\.\[ {subst first} |
---|
212 | {\a\$\.\[} {subst second} |
---|
213 | {{\a\$\.\[}} {subst third} |
---|
214 | default {subst none} |
---|
215 | } |
---|
216 | } second |
---|
217 | |
---|
218 | test switch-7.1 {"-" bodies} { |
---|
219 | switch a { |
---|
220 | a - |
---|
221 | b - |
---|
222 | c {subst 1} |
---|
223 | default {subst 2} |
---|
224 | } |
---|
225 | } 1 |
---|
226 | test switch-7.2 {"-" bodies} -body { |
---|
227 | switch a { |
---|
228 | a - |
---|
229 | b - |
---|
230 | c - |
---|
231 | } |
---|
232 | } -returnCodes error -result {no body specified for pattern "c"} |
---|
233 | test switch-7.3 {"-" bodies} -body { |
---|
234 | switch a { |
---|
235 | a - |
---|
236 | b -foo |
---|
237 | c - |
---|
238 | } |
---|
239 | } -returnCodes error -result {no body specified for pattern "c"} |
---|
240 | test switch-7.4 {"-" bodies} -body { |
---|
241 | switch a { |
---|
242 | a - |
---|
243 | b -foo |
---|
244 | c {} |
---|
245 | } |
---|
246 | } -returnCodes error -result {invalid command name "-foo"} |
---|
247 | |
---|
248 | test switch-8.1 {empty body} { |
---|
249 | set msg {} |
---|
250 | switch {2} { |
---|
251 | 1 {set msg 1} |
---|
252 | 2 {} |
---|
253 | default {set msg 2} |
---|
254 | } |
---|
255 | } {} |
---|
256 | proc test_switch_body {} { |
---|
257 | return "INVOKED" |
---|
258 | } |
---|
259 | test switch-8.2 {weird body text, variable} { |
---|
260 | set cmd {test_switch_body} |
---|
261 | switch Foo { |
---|
262 | Foo $cmd |
---|
263 | } |
---|
264 | } {INVOKED} |
---|
265 | test switch-8.3 {weird body text, variable} { |
---|
266 | set cmd {test_switch_body} |
---|
267 | switch Foo { |
---|
268 | Foo {$cmd} |
---|
269 | } |
---|
270 | } {INVOKED} |
---|
271 | |
---|
272 | test switch-9.1 {empty pattern/body list} -returnCodes error -body { |
---|
273 | switch x |
---|
274 | } -result {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"} |
---|
275 | test switch-9.2 {unpaired pattern} -returnCodes error -body { |
---|
276 | switch -- x |
---|
277 | } -result {extra switch pattern with no body} |
---|
278 | test switch-9.3 {empty pattern/body list} -body { |
---|
279 | switch x {} |
---|
280 | } -returnCodes error -result {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"} |
---|
281 | test switch-9.4 {empty pattern/body list} -body { |
---|
282 | switch -- x {} |
---|
283 | } -returnCodes error -result {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"} |
---|
284 | test switch-9.5 {unpaired pattern} -body { |
---|
285 | switch x a {} b |
---|
286 | } -returnCodes error -result {extra switch pattern with no body} |
---|
287 | test switch-9.6 {unpaired pattern} -body { |
---|
288 | switch x {a {} b} |
---|
289 | } -returnCodes error -result {extra switch pattern with no body} |
---|
290 | test switch-9.7 {unpaired pattern} -body { |
---|
291 | switch x a {} # comment b |
---|
292 | } -returnCodes error -result {extra switch pattern with no body} |
---|
293 | test switch-9.8 {unpaired pattern} -returnCodes error -body { |
---|
294 | switch x {a {} # comment b} |
---|
295 | } -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation} |
---|
296 | test switch-9.9 {unpaired pattern} -body { |
---|
297 | switch x a {} x {} # comment b |
---|
298 | } -returnCodes error -result {extra switch pattern with no body} |
---|
299 | test switch-9.10 {unpaired pattern} -returnCodes error -body { |
---|
300 | switch x {a {} x {} # comment b} |
---|
301 | } -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation} |
---|
302 | |
---|
303 | test switch-10.1 {compiled -exact switch} { |
---|
304 | if 1 {switch -exact -- a {a {subst 1} b {subst 2}}} |
---|
305 | } 1 |
---|
306 | test switch-10.1a {compiled -exact switch} { |
---|
307 | if 1 {switch -exact a {a {subst 1} b {subst 2}}} |
---|
308 | } 1 |
---|
309 | test switch-10.2 {compiled -exact switch} { |
---|
310 | if 1 {switch -exact -- b {a {subst 1} b {subst 2}}} |
---|
311 | } 2 |
---|
312 | test switch-10.2a {compiled -exact switch} { |
---|
313 | if 1 {switch -exact b {a {subst 1} b {subst 2}}} |
---|
314 | } 2 |
---|
315 | test switch-10.3 {compiled -exact switch} { |
---|
316 | if 1 {switch -exact -- c {a {subst 1} b {subst 2}}} |
---|
317 | } {} |
---|
318 | test switch-10.3a {compiled -exact switch} { |
---|
319 | if 1 {switch -exact c {a {subst 1} b {subst 2}}} |
---|
320 | } {} |
---|
321 | test switch-10.4 {compiled -exact switch} { |
---|
322 | if 1 { |
---|
323 | set x 0 |
---|
324 | switch -exact -- c {a {subst 1} b {subst 2}} |
---|
325 | } |
---|
326 | } {} |
---|
327 | test switch-10.5 {compiled -exact switch} { |
---|
328 | if 1 {switch -exact -- a {a - aa {subst 1} b {subst 2}}} |
---|
329 | } 1 |
---|
330 | test switch-10.6 {compiled -exact switch} { |
---|
331 | if 1 {switch -exact -- b {a { |
---|
332 | set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 |
---|
333 | set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 |
---|
334 | set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 |
---|
335 | set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 |
---|
336 | set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 |
---|
337 | set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 |
---|
338 | set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 |
---|
339 | set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 |
---|
340 | } b {subst 2}}} |
---|
341 | } 2 |
---|
342 | |
---|
343 | # Command variants are: |
---|
344 | # c* are compiled switches, i* are interpreted |
---|
345 | # *-glob use glob matching, *-exact use exact matching |
---|
346 | # *2* include a default clause (different results too.) |
---|
347 | proc cswtest-glob s { |
---|
348 | set x 0; set y 0 |
---|
349 | foreach c [split $s {}] { |
---|
350 | switch -glob $c { |
---|
351 | a {incr x} |
---|
352 | b {incr y} |
---|
353 | } |
---|
354 | } |
---|
355 | set x [expr {$x*100}]; set y [expr {$y*100}] |
---|
356 | foreach c [split $s {}] { |
---|
357 | switch -glob -- $c a {incr x} b {incr y} |
---|
358 | } |
---|
359 | return $x,$y |
---|
360 | } |
---|
361 | proc iswtest-glob s { |
---|
362 | set x 0; set y 0; set switch switch |
---|
363 | foreach c [split $s {}] { |
---|
364 | $switch -glob $c { |
---|
365 | a {incr x} |
---|
366 | b {incr y} |
---|
367 | } |
---|
368 | } |
---|
369 | set x [expr {$x*100}]; set y [expr {$y*100}] |
---|
370 | foreach c [split $s {}] { |
---|
371 | $switch -glob -- $c a {incr x} b {incr y} |
---|
372 | } |
---|
373 | return $x,$y |
---|
374 | } |
---|
375 | proc cswtest-exact s { |
---|
376 | set x 0; set y 0 |
---|
377 | foreach c [split $s {}] { |
---|
378 | switch -exact $c { |
---|
379 | a {incr x} |
---|
380 | b {incr y} |
---|
381 | } |
---|
382 | } |
---|
383 | set x [expr {$x*100}]; set y [expr {$y*100}] |
---|
384 | foreach c [split $s {}] { |
---|
385 | switch -exact -- $c a {incr x} b {incr y} |
---|
386 | } |
---|
387 | return $x,$y |
---|
388 | } |
---|
389 | proc iswtest-exact s { |
---|
390 | set x 0; set y 0; set switch switch |
---|
391 | foreach c [split $s {}] { |
---|
392 | $switch -exact $c { |
---|
393 | a {incr x} |
---|
394 | b {incr y} |
---|
395 | } |
---|
396 | } |
---|
397 | set x [expr {$x*100}]; set y [expr {$y*100}] |
---|
398 | foreach c [split $s {}] { |
---|
399 | $switch -exact -- $c a {incr x} b {incr y} |
---|
400 | } |
---|
401 | return $x,$y |
---|
402 | } |
---|
403 | proc cswtest2-glob s { |
---|
404 | set x 0; set y 0; set z 0 |
---|
405 | foreach c [split $s {}] { |
---|
406 | switch -glob $c { |
---|
407 | a {incr x} |
---|
408 | b {incr y} |
---|
409 | default {incr z} |
---|
410 | } |
---|
411 | } |
---|
412 | set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] |
---|
413 | foreach c [split $s {}] { |
---|
414 | switch -glob -- $c a {incr x} b {incr y} default {incr z} |
---|
415 | } |
---|
416 | return $x,$y,$z |
---|
417 | } |
---|
418 | proc iswtest2-glob s { |
---|
419 | set x 0; set y 0; set z 0; set switch switch |
---|
420 | foreach c [split $s {}] { |
---|
421 | $switch -glob $c { |
---|
422 | a {incr x} |
---|
423 | b {incr y} |
---|
424 | default {incr z} |
---|
425 | } |
---|
426 | } |
---|
427 | set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] |
---|
428 | foreach c [split $s {}] { |
---|
429 | $switch -glob -- $c a {incr x} b {incr y} default {incr z} |
---|
430 | } |
---|
431 | return $x,$y,$z |
---|
432 | } |
---|
433 | proc cswtest2-exact s { |
---|
434 | set x 0; set y 0; set z 0 |
---|
435 | foreach c [split $s {}] { |
---|
436 | switch -exact $c { |
---|
437 | a {incr x} |
---|
438 | b {incr y} |
---|
439 | default {incr z} |
---|
440 | } |
---|
441 | } |
---|
442 | set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] |
---|
443 | foreach c [split $s {}] { |
---|
444 | switch -exact -- $c a {incr x} b {incr y} default {incr z} |
---|
445 | } |
---|
446 | return $x,$y,$z |
---|
447 | } |
---|
448 | proc iswtest2-exact s { |
---|
449 | set x 0; set y 0; set z 0; set switch switch |
---|
450 | foreach c [split $s {}] { |
---|
451 | $switch -exact $c { |
---|
452 | a {incr x} |
---|
453 | b {incr y} |
---|
454 | default {incr z} |
---|
455 | } |
---|
456 | } |
---|
457 | set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] |
---|
458 | foreach c [split $s {}] { |
---|
459 | $switch -exact -- $c a {incr x} b {incr y} default {incr z} |
---|
460 | } |
---|
461 | return $x,$y,$z |
---|
462 | } |
---|
463 | |
---|
464 | test switch-10.7 {comparison of compiled and interpreted behaviour of switch, exact matching} { |
---|
465 | cswtest-exact abcb |
---|
466 | } [iswtest-exact abcb] |
---|
467 | test switch-10.8 {comparison of compiled and interpreted behaviour of switch, glob matching} { |
---|
468 | cswtest-glob abcb |
---|
469 | } [iswtest-glob abcb] |
---|
470 | test switch-10.9 {comparison of compiled and interpreted behaviour of switch, exact matching with default} { |
---|
471 | cswtest2-exact abcb |
---|
472 | } [iswtest2-exact abcb] |
---|
473 | test switch-10.10 {comparison of compiled and interpreted behaviour of switch, glob matching with default} { |
---|
474 | cswtest2-glob abcb |
---|
475 | } [iswtest2-glob abcb] |
---|
476 | proc cswtest-default-exact {x} { |
---|
477 | switch -- $x { |
---|
478 | a* {return b} |
---|
479 | aa {return c} |
---|
480 | default {return d} |
---|
481 | } |
---|
482 | } |
---|
483 | test switch-10.11 {default to exact matching when compiled} { |
---|
484 | cswtest-default-exact a |
---|
485 | } d |
---|
486 | test switch-10.12 {default to exact matching when compiled} { |
---|
487 | cswtest-default-exact aa |
---|
488 | } c |
---|
489 | test switch-10.13 {default to exact matching when compiled} { |
---|
490 | cswtest-default-exact a* |
---|
491 | } b |
---|
492 | test switch-10.14 {default to exact matching when compiled} { |
---|
493 | cswtest-default-exact a** |
---|
494 | } d |
---|
495 | rename cswtest-default-exact {} |
---|
496 | rename cswtest-glob {} |
---|
497 | rename iswtest-glob {} |
---|
498 | rename cswtest2-glob {} |
---|
499 | rename iswtest2-glob {} |
---|
500 | rename cswtest-exact {} |
---|
501 | rename iswtest-exact {} |
---|
502 | rename cswtest2-exact {} |
---|
503 | rename iswtest2-exact {} |
---|
504 | # Bug 1891827 |
---|
505 | test switch-10.15 {(not) compiled exact nocase regression} { |
---|
506 | apply {{} { |
---|
507 | switch -nocase -- A { a {return yes} default {return no} } |
---|
508 | }} |
---|
509 | } yes |
---|
510 | |
---|
511 | # Added due to TIP#75 |
---|
512 | test switch-11.1 {regexp matching with -matchvar} { |
---|
513 | switch -regexp -matchvar x -- abc {.(.). {set x}} |
---|
514 | } {abc b} |
---|
515 | test switch-11.2 {regexp matching with -matchvar} { |
---|
516 | set x GOOD |
---|
517 | switch -regexp -matchvar x -- abc {.(.).. {list $x z}} |
---|
518 | set x |
---|
519 | } GOOD |
---|
520 | test switch-11.3 {regexp matching with -matchvar} { |
---|
521 | switch -regexp -matchvar x -- "a b c" {.(.). {set x}} |
---|
522 | } {{a b} { }} |
---|
523 | test switch-11.4 {regexp matching with -matchvar} { |
---|
524 | set x BAD |
---|
525 | switch -regexp -matchvar x -- "a b c" { |
---|
526 | bc {list $x YES} |
---|
527 | default {list $x NO} |
---|
528 | } |
---|
529 | } {{} NO} |
---|
530 | test switch-11.5 {-matchvar without -regexp} { |
---|
531 | set x {} |
---|
532 | list [catch {switch -glob -matchvar x -- abc . {set x}} msg] $x $msg |
---|
533 | } {1 {} {-matchvar option requires -regexp option}} |
---|
534 | test switch-11.6 {-matchvar unwritable} { |
---|
535 | set x {} |
---|
536 | list [catch {switch -regexp -matchvar x(x) -- abc . {set x}} msg] $x $msg |
---|
537 | } {1 {} {can't set "x(x)": variable isn't array}} |
---|
538 | |
---|
539 | test switch-12.1 {regexp matching with -indexvar} { |
---|
540 | switch -regexp -indexvar x -- abc {.(.). {set x}} |
---|
541 | } {{0 3} {1 2}} |
---|
542 | test switch-12.2 {regexp matching with -indexvar} { |
---|
543 | set x GOOD |
---|
544 | switch -regexp -indexvar x -- abc {.(.).. {list $x z}} |
---|
545 | set x |
---|
546 | } GOOD |
---|
547 | test switch-12.3 {regexp matching with -indexvar} { |
---|
548 | switch -regexp -indexvar x -- "a b c" {.(.). {set x}} |
---|
549 | } {{0 3} {1 2}} |
---|
550 | test switch-12.4 {regexp matching with -indexvar} { |
---|
551 | set x BAD |
---|
552 | switch -regexp -indexvar x -- "a b c" { |
---|
553 | bc {list $x YES} |
---|
554 | default {list $x NO} |
---|
555 | } |
---|
556 | } {{} NO} |
---|
557 | test switch-12.5 {-indexvar without -regexp} { |
---|
558 | set x {} |
---|
559 | list [catch {switch -glob -indexvar x -- abc . {set x}} msg] $x $msg |
---|
560 | } {1 {} {-indexvar option requires -regexp option}} |
---|
561 | test switch-12.6 {-indexvar unwritable} { |
---|
562 | set x {} |
---|
563 | list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg |
---|
564 | } {1 {} {can't set "x(x)": variable isn't array}} |
---|
565 | |
---|
566 | test switch-13.1 {-indexvar -matchvar combinations} { |
---|
567 | switch -regexp -indexvar x -matchvar y abc { |
---|
568 | . {list $x $y} |
---|
569 | } |
---|
570 | } {{{0 1}} a} |
---|
571 | test switch-13.2 {-indexvar -matchvar combinations} { |
---|
572 | switch -regexp -indexvar x -matchvar y abc { |
---|
573 | .$ {list $x $y} |
---|
574 | } |
---|
575 | } {{{2 3}} c} |
---|
576 | test switch-13.3 {-indexvar -matchvar combinations} { |
---|
577 | switch -regexp -indexvar x -matchvar y abc { |
---|
578 | (.)(.)(.) {list $x $y} |
---|
579 | } |
---|
580 | } {{{0 3} {0 1} {1 2} {2 3}} {abc a b c}} |
---|
581 | test switch-13.4 {-indexvar -matchvar combinations} { |
---|
582 | set x - |
---|
583 | set y - |
---|
584 | switch -regexp -indexvar x -matchvar y abc { |
---|
585 | (.)(.)(.). - |
---|
586 | default {list $x $y} |
---|
587 | } |
---|
588 | } {{} {}} |
---|
589 | test switch-13.5 {-indexvar -matchvar combinations} { |
---|
590 | set x - |
---|
591 | set y - |
---|
592 | list [catch { |
---|
593 | switch -regexp -indexvar x(x) -matchvar y abc {. {list $x $y}} |
---|
594 | } msg] $x $y $msg |
---|
595 | } {1 - - {can't set "x(x)": variable isn't array}} |
---|
596 | test switch-13.6 {-indexvar -matchvar combinations} { |
---|
597 | set x - |
---|
598 | set y - |
---|
599 | list [catch { |
---|
600 | switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}} |
---|
601 | } msg] $x $y $msg |
---|
602 | } {1 {{0 1}} - {can't set "y(y)": variable isn't array}} |
---|
603 | |
---|
604 | test switch-14.1 {-regexp -- compilation [Bug 1854399]} { |
---|
605 | switch -regexp -- 0 { |
---|
606 | {[0-9]+} {return yes} |
---|
607 | default {return no} |
---|
608 | } |
---|
609 | foo |
---|
610 | } yes |
---|
611 | test switch-14.2 {-regexp -- compilation [Bug 1854399]} { |
---|
612 | proc foo {} { |
---|
613 | switch -regexp -- 0 { |
---|
614 | {[0-9]+} {return yes} |
---|
615 | default {return no} |
---|
616 | } |
---|
617 | } |
---|
618 | foo |
---|
619 | } yes |
---|
620 | test switch-14.3 {-regexp -- compilation [Bug 1854399]} { |
---|
621 | proc foo {} { |
---|
622 | switch -regexp -- 0 { |
---|
623 | {\d+} {return yes} |
---|
624 | default {return no} |
---|
625 | } |
---|
626 | } |
---|
627 | foo |
---|
628 | } yes |
---|
629 | test switch-14.4 {-regexp -- compilation [Bug 1854399]} { |
---|
630 | proc foo {} { |
---|
631 | switch -regexp -- 0 { |
---|
632 | {0} {return yes} |
---|
633 | default {return no} |
---|
634 | } |
---|
635 | } |
---|
636 | foo |
---|
637 | } yes |
---|
638 | test switch-14.5 {switch -regexp compilation} { |
---|
639 | apply {{} { |
---|
640 | switch -regexp -- 0 { |
---|
641 | {0|1|2} {return yes} |
---|
642 | default {return no} |
---|
643 | } |
---|
644 | }} |
---|
645 | } yes |
---|
646 | test switch-14.6 {switch -regexp compilation} { |
---|
647 | apply {{} { |
---|
648 | switch -regexp -- 0 { |
---|
649 | {0|11|222} {return yes} |
---|
650 | default {return no} |
---|
651 | } |
---|
652 | }} |
---|
653 | } yes |
---|
654 | test switch-14.7 {switch -regexp compilation} { |
---|
655 | apply {{} { |
---|
656 | switch -regexp -- 0 { |
---|
657 | {[012]} {return yes} |
---|
658 | default {return no} |
---|
659 | } |
---|
660 | }} |
---|
661 | } yes |
---|
662 | test switch-14.8 {switch -regexp compilation} { |
---|
663 | apply {{} { |
---|
664 | switch -regexp -- x { |
---|
665 | {0|1|2} {return yes} |
---|
666 | default {return no} |
---|
667 | } |
---|
668 | }} |
---|
669 | } no |
---|
670 | test switch-14.9 {switch -regexp compilation} { |
---|
671 | apply {{} { |
---|
672 | switch -regexp -- x { |
---|
673 | {0|11|222} {return yes} |
---|
674 | default {return no} |
---|
675 | } |
---|
676 | }} |
---|
677 | } no |
---|
678 | test switch-14.10 {switch -regexp compilation} { |
---|
679 | apply {{} { |
---|
680 | switch -regexp -- x { |
---|
681 | {[012]} {return yes} |
---|
682 | default {return no} |
---|
683 | } |
---|
684 | }} |
---|
685 | } no |
---|
686 | test switch-14.11 {switch -regexp compilation} { |
---|
687 | apply {{} { |
---|
688 | switch -regexp -- x { |
---|
689 | {0|1|2} {return yes} |
---|
690 | .+ {return yes2} |
---|
691 | default {return no} |
---|
692 | } |
---|
693 | }} |
---|
694 | } yes2 |
---|
695 | test switch-14.12 {switch -regexp compilation} { |
---|
696 | apply {{} { |
---|
697 | switch -regexp -- x { |
---|
698 | {0|11|222} {return yes} |
---|
699 | .+ {return yes2} |
---|
700 | default {return no} |
---|
701 | } |
---|
702 | }} |
---|
703 | } yes2 |
---|
704 | test switch-14.13 {switch -regexp compilation} { |
---|
705 | apply {{} { |
---|
706 | switch -regexp -- x { |
---|
707 | {[012]} {return yes} |
---|
708 | .+ {return yes2} |
---|
709 | default {return no} |
---|
710 | } |
---|
711 | }} |
---|
712 | } yes2 |
---|
713 | test switch-14.14 {switch -regexp compilation} { |
---|
714 | apply {{} { |
---|
715 | switch -regexp -- {} { |
---|
716 | {0|1|2} {return yes} |
---|
717 | .+ {return yes2} |
---|
718 | default {return no} |
---|
719 | } |
---|
720 | }} |
---|
721 | } no |
---|
722 | test switch-14.15 {switch -regexp compilation} { |
---|
723 | apply {{} { |
---|
724 | switch -regexp -- {} { |
---|
725 | {0|11|222} {return yes} |
---|
726 | .+ {return yes2} |
---|
727 | default {return no} |
---|
728 | } |
---|
729 | }} |
---|
730 | } no |
---|
731 | test switch-14.16 {switch -regexp compilation} { |
---|
732 | apply {{} { |
---|
733 | switch -regexp -- {} { |
---|
734 | {[012]} {return yes} |
---|
735 | .+ {return yes2} |
---|
736 | default {return no} |
---|
737 | } |
---|
738 | }} |
---|
739 | } no |
---|
740 | |
---|
741 | # cleanup |
---|
742 | ::tcltest::cleanupTests |
---|
743 | return |
---|
744 | |
---|
745 | # Local Variables: |
---|
746 | # mode: tcl |
---|
747 | # End: |
---|