1 | # Commands covered: if |
---|
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) 1996 Sun Microsystems, Inc. |
---|
8 | # Copyright (c) 1998-1999 by Scriptics Corporation. |
---|
9 | # |
---|
10 | # See the file "license.terms" for information on usage and redistribution |
---|
11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
12 | # |
---|
13 | # RCS: @(#) $Id: if.test,v 1.12 2006/10/09 19:15:44 msofer Exp $ |
---|
14 | |
---|
15 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
16 | package require tcltest 2 |
---|
17 | namespace import -force ::tcltest::* |
---|
18 | } |
---|
19 | |
---|
20 | # Basic "if" operation. |
---|
21 | |
---|
22 | catch {unset a} |
---|
23 | test if-1.1 {TclCompileIfCmd: missing if/elseif test} { |
---|
24 | list [catch {if} msg] $msg |
---|
25 | } {1 {wrong # args: no expression after "if" argument}} |
---|
26 | test if-1.2 {TclCompileIfCmd: error in if/elseif test} { |
---|
27 | list [catch {if {[error "error in condition"]} foo} msg] $msg |
---|
28 | } {1 {error in condition}} |
---|
29 | test if-1.3 {TclCompileIfCmd: error in if/elseif test} -body { |
---|
30 | list [catch {if {1+}} msg] $msg $::errorInfo |
---|
31 | } -match glob -result {1 * {*"if {1+}"}} |
---|
32 | test if-1.4 {TclCompileIfCmd: if/elseif test in braces} { |
---|
33 | set a {} |
---|
34 | if {1<2} {set a 1} |
---|
35 | set a |
---|
36 | } {1} |
---|
37 | test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} { |
---|
38 | set a {} |
---|
39 | if 1<2 {set a 1} |
---|
40 | set a |
---|
41 | } {1} |
---|
42 | test if-1.6 {TclCompileIfCmd: multiline test expr} { |
---|
43 | set a {} |
---|
44 | if {($tcl_platform(platform) != "foobar1") && \ |
---|
45 | ($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4} |
---|
46 | set a |
---|
47 | } 3 |
---|
48 | test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} { |
---|
49 | set a {} |
---|
50 | if 4>3 then {set a 1} |
---|
51 | set a |
---|
52 | } {1} |
---|
53 | test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} { |
---|
54 | set a {} |
---|
55 | catch {if 1<2 therefore {set a 1}} msg |
---|
56 | set msg |
---|
57 | } {invalid command name "therefore"} |
---|
58 | test if-1.9 {TclCompileIfCmd: missing "then" body} { |
---|
59 | set a {} |
---|
60 | catch {if 1<2 then} msg |
---|
61 | set msg |
---|
62 | } {wrong # args: no script following "then" argument} |
---|
63 | test if-1.10 {TclCompileIfCmd: error in "then" body} -body { |
---|
64 | set a {} |
---|
65 | list [catch {if {$a!="xxx"} then {set}} msg] $msg $::errorInfo |
---|
66 | } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" |
---|
67 | while *ing |
---|
68 | "set"*}} |
---|
69 | test if-1.11 {TclCompileIfCmd: error in "then" body} { |
---|
70 | list [catch {if 2 then {[error "error in then clause"]}} msg] $msg |
---|
71 | } {1 {error in then clause}} |
---|
72 | test if-1.12 {TclCompileIfCmd: "then" body in quotes} { |
---|
73 | set a {} |
---|
74 | if 27>17 "append a x" |
---|
75 | set a |
---|
76 | } {x} |
---|
77 | test if-1.13 {TclCompileIfCmd: computed "then" body} { |
---|
78 | catch {unset x1} |
---|
79 | catch {unset x2} |
---|
80 | set a {} |
---|
81 | set x1 {append a x1} |
---|
82 | set x2 {; append a x2} |
---|
83 | set a {} |
---|
84 | if 1 $x1$x2 |
---|
85 | set a |
---|
86 | } {x1x2} |
---|
87 | test if-1.14 {TclCompileIfCmd: taking proper branch} { |
---|
88 | set a {} |
---|
89 | if 1<2 {set a 1} |
---|
90 | set a |
---|
91 | } 1 |
---|
92 | test if-1.15 {TclCompileIfCmd: taking proper branch} { |
---|
93 | set a {} |
---|
94 | if 1>2 {set a 1} |
---|
95 | set a |
---|
96 | } {} |
---|
97 | test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} { |
---|
98 | catch {unset i} |
---|
99 | set a {} |
---|
100 | if 1<2 { |
---|
101 | set a 1 |
---|
102 | while {$a != "xxx"} { |
---|
103 | break; |
---|
104 | while {$i >= 0} { |
---|
105 | if {[string compare $a "bar"] < 0} { |
---|
106 | set i $i |
---|
107 | set i [lindex $s $i] |
---|
108 | } |
---|
109 | if {[string compare $a "bar"] < 0} { |
---|
110 | set i $i |
---|
111 | set i [lindex $s $i] |
---|
112 | } |
---|
113 | if {[string compare $a "bar"] < 0} { |
---|
114 | set i $i |
---|
115 | set i [lindex $s $i] |
---|
116 | } |
---|
117 | if {[string compare $a "bar"] < 0} { |
---|
118 | set i $i |
---|
119 | set i [lindex $s $i] |
---|
120 | } |
---|
121 | set i [expr $i-1] |
---|
122 | } |
---|
123 | } |
---|
124 | set a 2 |
---|
125 | while {$a != "xxx"} { |
---|
126 | break; |
---|
127 | while {$i >= 0} { |
---|
128 | if {[string compare $a "bar"] < 0} { |
---|
129 | set i $i |
---|
130 | set i [lindex $s $i] |
---|
131 | } |
---|
132 | if {[string compare $a "bar"] < 0} { |
---|
133 | set i $i |
---|
134 | set i [lindex $s $i] |
---|
135 | } |
---|
136 | if {[string compare $a "bar"] < 0} { |
---|
137 | set i $i |
---|
138 | set i [lindex $s $i] |
---|
139 | } |
---|
140 | if {[string compare $a "bar"] < 0} { |
---|
141 | set i $i |
---|
142 | set i [lindex $s $i] |
---|
143 | } |
---|
144 | set i [expr $i-1] |
---|
145 | } |
---|
146 | } |
---|
147 | set a 3 |
---|
148 | } |
---|
149 | set a |
---|
150 | } 3 |
---|
151 | test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} { |
---|
152 | set a {} |
---|
153 | list [catch {if {"0 < 3"} {set a 1}} msg] $msg |
---|
154 | } {1 {expected boolean value but got "0 < 3"}} |
---|
155 | |
---|
156 | |
---|
157 | test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} { |
---|
158 | set a {} |
---|
159 | if 3>4 {set a 1} elseif 1 {set a 2} |
---|
160 | set a |
---|
161 | } {2} |
---|
162 | # Since "else" is optional, the "elwood" below is treated as a command. |
---|
163 | # But then there shouldn't be any additional argument words for the "if". |
---|
164 | test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} { |
---|
165 | set a {} |
---|
166 | catch {if 1<2 {set a 1} elwood {set a 2}} msg |
---|
167 | set msg |
---|
168 | } {wrong # args: extra words after "else" clause in "if" command} |
---|
169 | test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} { |
---|
170 | set a {} |
---|
171 | catch {if 1<2 {set a 1} elseif} msg |
---|
172 | set msg |
---|
173 | } {wrong # args: no expression after "elseif" argument} |
---|
174 | test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} -body { |
---|
175 | set a {} |
---|
176 | list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $::errorInfo |
---|
177 | } -match glob -result {1 * {*"if 3>4 {set a 1} elseif {1>}"}} |
---|
178 | test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} { |
---|
179 | catch {unset i} |
---|
180 | set a {} |
---|
181 | if 1>2 { |
---|
182 | set a 1 |
---|
183 | while {$a != "xxx"} { |
---|
184 | break; |
---|
185 | while {$i >= 0} { |
---|
186 | if {[string compare $a "bar"] < 0} { |
---|
187 | set i $i |
---|
188 | set i [lindex $s $i] |
---|
189 | } |
---|
190 | if {[string compare $a "bar"] < 0} { |
---|
191 | set i $i |
---|
192 | set i [lindex $s $i] |
---|
193 | } |
---|
194 | if {[string compare $a "bar"] < 0} { |
---|
195 | set i $i |
---|
196 | set i [lindex $s $i] |
---|
197 | } |
---|
198 | if {[string compare $a "bar"] < 0} { |
---|
199 | set i $i |
---|
200 | set i [lindex $s $i] |
---|
201 | } |
---|
202 | set i [expr $i-1] |
---|
203 | } |
---|
204 | } |
---|
205 | set a 2 |
---|
206 | while {$a != "xxx"} { |
---|
207 | break; |
---|
208 | while {$i >= 0} { |
---|
209 | if {[string compare $a "bar"] < 0} { |
---|
210 | set i $i |
---|
211 | set i [lindex $s $i] |
---|
212 | } |
---|
213 | if {[string compare $a "bar"] < 0} { |
---|
214 | set i $i |
---|
215 | set i [lindex $s $i] |
---|
216 | } |
---|
217 | if {[string compare $a "bar"] < 0} { |
---|
218 | set i $i |
---|
219 | set i [lindex $s $i] |
---|
220 | } |
---|
221 | if {[string compare $a "bar"] < 0} { |
---|
222 | set i $i |
---|
223 | set i [lindex $s $i] |
---|
224 | } |
---|
225 | set i [expr $i-1] |
---|
226 | } |
---|
227 | } |
---|
228 | set a 3 |
---|
229 | } elseif 1<2 then { #; this if arm should be taken |
---|
230 | set a 4 |
---|
231 | while {$a != "xxx"} { |
---|
232 | break; |
---|
233 | while {$i >= 0} { |
---|
234 | if {[string compare $a "bar"] < 0} { |
---|
235 | set i $i |
---|
236 | set i [lindex $s $i] |
---|
237 | } |
---|
238 | if {[string compare $a "bar"] < 0} { |
---|
239 | set i $i |
---|
240 | set i [lindex $s $i] |
---|
241 | } |
---|
242 | if {[string compare $a "bar"] < 0} { |
---|
243 | set i $i |
---|
244 | set i [lindex $s $i] |
---|
245 | } |
---|
246 | if {[string compare $a "bar"] < 0} { |
---|
247 | set i $i |
---|
248 | set i [lindex $s $i] |
---|
249 | } |
---|
250 | set i [expr $i-1] |
---|
251 | } |
---|
252 | } |
---|
253 | set a 5 |
---|
254 | while {$a != "xxx"} { |
---|
255 | break; |
---|
256 | while {$i >= 0} { |
---|
257 | if {[string compare $a "bar"] < 0} { |
---|
258 | set i $i |
---|
259 | set i [lindex $s $i] |
---|
260 | } |
---|
261 | if {[string compare $a "bar"] < 0} { |
---|
262 | set i $i |
---|
263 | set i [lindex $s $i] |
---|
264 | } |
---|
265 | if {[string compare $a "bar"] < 0} { |
---|
266 | set i $i |
---|
267 | set i [lindex $s $i] |
---|
268 | } |
---|
269 | if {[string compare $a "bar"] < 0} { |
---|
270 | set i $i |
---|
271 | set i [lindex $s $i] |
---|
272 | } |
---|
273 | set i [expr $i-1] |
---|
274 | } |
---|
275 | } |
---|
276 | set a 6 |
---|
277 | } |
---|
278 | set a |
---|
279 | } 6 |
---|
280 | |
---|
281 | test if-3.1 {TclCompileIfCmd: "else" clause} { |
---|
282 | set a {} |
---|
283 | if 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3} |
---|
284 | set a |
---|
285 | } 3 |
---|
286 | # Since "else" is optional, the "elsex" below is treated as a command. |
---|
287 | # But then there shouldn't be any additional argument words for the "if". |
---|
288 | test if-3.2 {TclCompileIfCmd: keyword other than "else"} { |
---|
289 | set a {} |
---|
290 | catch {if 1<2 then {set a 1} elsex {set a 2}} msg |
---|
291 | set msg |
---|
292 | } {wrong # args: extra words after "else" clause in "if" command} |
---|
293 | test if-3.3 {TclCompileIfCmd: missing body after "else"} { |
---|
294 | set a {} |
---|
295 | catch {if 2<1 {set a 1} else} msg |
---|
296 | set msg |
---|
297 | } {wrong # args: no script following "else" argument} |
---|
298 | test if-3.4 {TclCompileIfCmd: error compiling body after "else"} -body { |
---|
299 | set a {} |
---|
300 | catch {if 2<1 {set a 1} else {set}} msg |
---|
301 | set ::errorInfo |
---|
302 | } -match glob -result {wrong # args: should be "set varName ?newValue?" |
---|
303 | while *ing |
---|
304 | "set"*} |
---|
305 | test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} { |
---|
306 | set a {} |
---|
307 | catch {if 2<1 {set a 1} else {set a 2} or something} msg |
---|
308 | set msg |
---|
309 | } {wrong # args: extra words after "else" clause in "if" command} |
---|
310 | # The following test also checks whether contained loops and other |
---|
311 | # commands are properly relocated because a short jump must be replaced |
---|
312 | # by a "long distance" one. |
---|
313 | test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} { |
---|
314 | catch {unset i} |
---|
315 | set a {} |
---|
316 | if 1>2 { |
---|
317 | set a 1 |
---|
318 | while {$a != "xxx"} { |
---|
319 | break; |
---|
320 | while {$i >= 0} { |
---|
321 | if {[string compare $a "bar"] < 0} { |
---|
322 | set i $i |
---|
323 | set i [lindex $s $i] |
---|
324 | } |
---|
325 | if {[string compare $a "bar"] < 0} { |
---|
326 | set i $i |
---|
327 | set i [lindex $s $i] |
---|
328 | } |
---|
329 | if {[string compare $a "bar"] < 0} { |
---|
330 | set i $i |
---|
331 | set i [lindex $s $i] |
---|
332 | } |
---|
333 | if {[string compare $a "bar"] < 0} { |
---|
334 | set i $i |
---|
335 | set i [lindex $s $i] |
---|
336 | } |
---|
337 | set i [expr $i-1] |
---|
338 | } |
---|
339 | } |
---|
340 | set a 2 |
---|
341 | while {$a != "xxx"} { |
---|
342 | break; |
---|
343 | while {$i >= 0} { |
---|
344 | if {[string compare $a "bar"] < 0} { |
---|
345 | set i $i |
---|
346 | set i [lindex $s $i] |
---|
347 | } |
---|
348 | if {[string compare $a "bar"] < 0} { |
---|
349 | set i $i |
---|
350 | set i [lindex $s $i] |
---|
351 | } |
---|
352 | if {[string compare $a "bar"] < 0} { |
---|
353 | set i $i |
---|
354 | set i [lindex $s $i] |
---|
355 | } |
---|
356 | if {[string compare $a "bar"] < 0} { |
---|
357 | set i $i |
---|
358 | set i [lindex $s $i] |
---|
359 | } |
---|
360 | set i [expr $i-1] |
---|
361 | } |
---|
362 | } |
---|
363 | set a 3 |
---|
364 | } elseif 1==2 then { #; this if arm should be taken |
---|
365 | set a 4 |
---|
366 | while {$a != "xxx"} { |
---|
367 | break; |
---|
368 | while {$i >= 0} { |
---|
369 | if {[string compare $a "bar"] < 0} { |
---|
370 | set i $i |
---|
371 | set i [lindex $s $i] |
---|
372 | } |
---|
373 | if {[string compare $a "bar"] < 0} { |
---|
374 | set i $i |
---|
375 | set i [lindex $s $i] |
---|
376 | } |
---|
377 | if {[string compare $a "bar"] < 0} { |
---|
378 | set i $i |
---|
379 | set i [lindex $s $i] |
---|
380 | } |
---|
381 | if {[string compare $a "bar"] < 0} { |
---|
382 | set i $i |
---|
383 | set i [lindex $s $i] |
---|
384 | } |
---|
385 | set i [expr $i-1] |
---|
386 | } |
---|
387 | } |
---|
388 | set a 5 |
---|
389 | while {$a != "xxx"} { |
---|
390 | break; |
---|
391 | while {$i >= 0} { |
---|
392 | if {[string compare $a "bar"] < 0} { |
---|
393 | set i $i |
---|
394 | set i [lindex $s $i] |
---|
395 | } |
---|
396 | if {[string compare $a "bar"] < 0} { |
---|
397 | set i $i |
---|
398 | set i [lindex $s $i] |
---|
399 | } |
---|
400 | if {[string compare $a "bar"] < 0} { |
---|
401 | set i $i |
---|
402 | set i [lindex $s $i] |
---|
403 | } |
---|
404 | if {[string compare $a "bar"] < 0} { |
---|
405 | set i $i |
---|
406 | set i [lindex $s $i] |
---|
407 | } |
---|
408 | set i [expr $i-1] |
---|
409 | } |
---|
410 | } |
---|
411 | set a 6 |
---|
412 | } else { |
---|
413 | set a 7 |
---|
414 | while {$a != "xxx"} { |
---|
415 | break; |
---|
416 | while {$i >= 0} { |
---|
417 | if {[string compare $a "bar"] < 0} { |
---|
418 | set i $i |
---|
419 | set i [lindex $s $i] |
---|
420 | } |
---|
421 | if {[string compare $a "bar"] < 0} { |
---|
422 | set i $i |
---|
423 | set i [lindex $s $i] |
---|
424 | } |
---|
425 | if {[string compare $a "bar"] < 0} { |
---|
426 | set i $i |
---|
427 | set i [lindex $s $i] |
---|
428 | } |
---|
429 | if {[string compare $a "bar"] < 0} { |
---|
430 | set i $i |
---|
431 | set i [lindex $s $i] |
---|
432 | } |
---|
433 | set i [expr $i-1] |
---|
434 | } |
---|
435 | } |
---|
436 | set a 8 |
---|
437 | while {$a != "xxx"} { |
---|
438 | break; |
---|
439 | while {$i >= 0} { |
---|
440 | if {[string compare $a "bar"] < 0} { |
---|
441 | set i $i |
---|
442 | set i [lindex $s $i] |
---|
443 | } |
---|
444 | if {[string compare $a "bar"] < 0} { |
---|
445 | set i $i |
---|
446 | set i [lindex $s $i] |
---|
447 | } |
---|
448 | if {[string compare $a "bar"] < 0} { |
---|
449 | set i $i |
---|
450 | set i [lindex $s $i] |
---|
451 | } |
---|
452 | if {[string compare $a "bar"] < 0} { |
---|
453 | set i $i |
---|
454 | set i [lindex $s $i] |
---|
455 | } |
---|
456 | set i [expr $i-1] |
---|
457 | } |
---|
458 | } |
---|
459 | set a 9 |
---|
460 | } |
---|
461 | set a |
---|
462 | } 9 |
---|
463 | |
---|
464 | test if-4.1 {TclCompileIfCmd: "if" command result} { |
---|
465 | set a {} |
---|
466 | set a [if 3<4 {set i 27}] |
---|
467 | set a |
---|
468 | } 27 |
---|
469 | test if-4.2 {TclCompileIfCmd: "if" command result} { |
---|
470 | set a {} |
---|
471 | set a [if 3>4 {set i 27}] |
---|
472 | set a |
---|
473 | } {} |
---|
474 | test if-4.3 {TclCompileIfCmd: "if" command result} { |
---|
475 | set a {} |
---|
476 | set a [if 0 {set i 1} elseif 1 {set i 2}] |
---|
477 | set a |
---|
478 | } 2 |
---|
479 | test if-4.4 {TclCompileIfCmd: "if" command result} { |
---|
480 | set a {} |
---|
481 | set a [if 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}] |
---|
482 | set a |
---|
483 | } 4 |
---|
484 | test if-4.5 {TclCompileIfCmd: return value} { |
---|
485 | if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi} |
---|
486 | } def |
---|
487 | |
---|
488 | # Check "if" and computed command names. |
---|
489 | |
---|
490 | catch {unset a} |
---|
491 | test if-5.1 {if cmd with computed command names: missing if/elseif test} { |
---|
492 | set z if |
---|
493 | list [catch {$z} msg] $msg |
---|
494 | } {1 {wrong # args: no expression after "if" argument}} |
---|
495 | |
---|
496 | test if-5.2 {if cmd with computed command names: error in if/elseif test} { |
---|
497 | set z if |
---|
498 | list [catch {$z {[error "error in condition"]} foo} msg] $msg |
---|
499 | } {1 {error in condition}} |
---|
500 | test if-5.3 {if cmd with computed command names: error in if/elseif test} -body { |
---|
501 | set z if |
---|
502 | list [catch {$z {1+}} msg] $msg $::errorInfo |
---|
503 | } -match glob -result {1 * {*"$z {1+}"}} |
---|
504 | test if-5.4 {if cmd with computed command names: if/elseif test in braces} { |
---|
505 | set z if |
---|
506 | set a {} |
---|
507 | $z {1<2} {set a 1} |
---|
508 | set a |
---|
509 | } {1} |
---|
510 | test if-5.5 {if cmd with computed command names: if/elseif test not in braces} { |
---|
511 | set z if |
---|
512 | set a {} |
---|
513 | $z 1<2 {set a 1} |
---|
514 | set a |
---|
515 | } {1} |
---|
516 | test if-5.6 {if cmd with computed command names: multiline test expr} { |
---|
517 | set z if |
---|
518 | set a {} |
---|
519 | $z {($tcl_platform(platform) != "foobar1") && \ |
---|
520 | ($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4} |
---|
521 | set a |
---|
522 | } 3 |
---|
523 | test if-5.7 {if cmd with computed command names: "then" after if/elseif test} { |
---|
524 | set z if |
---|
525 | set a {} |
---|
526 | $z 4>3 then {set a 1} |
---|
527 | set a |
---|
528 | } {1} |
---|
529 | test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} { |
---|
530 | set z if |
---|
531 | set a {} |
---|
532 | catch {$z 1<2 therefore {set a 1}} msg |
---|
533 | set msg |
---|
534 | } {invalid command name "therefore"} |
---|
535 | test if-5.9 {if cmd with computed command names: missing "then" body} { |
---|
536 | set z if |
---|
537 | set a {} |
---|
538 | catch {$z 1<2 then} msg |
---|
539 | set msg |
---|
540 | } {wrong # args: no script following "then" argument} |
---|
541 | test if-5.10 {if cmd with computed command names: error in "then" body} -body { |
---|
542 | set z if |
---|
543 | set a {} |
---|
544 | list [catch {$z {$a!="xxx"} then {set}} msg] $msg $::errorInfo |
---|
545 | } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" |
---|
546 | while *ing |
---|
547 | "set" |
---|
548 | invoked from within |
---|
549 | "$z {$a!="xxx"} then {set}"}} |
---|
550 | test if-5.11 {if cmd with computed command names: error in "then" body} { |
---|
551 | set z if |
---|
552 | list [catch {$z 2 then {[error "error in then clause"]}} msg] $msg |
---|
553 | } {1 {error in then clause}} |
---|
554 | test if-5.12 {if cmd with computed command names: "then" body in quotes} { |
---|
555 | set z if |
---|
556 | set a {} |
---|
557 | $z 27>17 "append a x" |
---|
558 | set a |
---|
559 | } {x} |
---|
560 | test if-5.13 {if cmd with computed command names: computed "then" body} { |
---|
561 | set z if |
---|
562 | catch {unset x1} |
---|
563 | catch {unset x2} |
---|
564 | set a {} |
---|
565 | set x1 {append a x1} |
---|
566 | set x2 {; append a x2} |
---|
567 | set a {} |
---|
568 | $z 1 $x1$x2 |
---|
569 | set a |
---|
570 | } {x1x2} |
---|
571 | test if-5.14 {if cmd with computed command names: taking proper branch} { |
---|
572 | set z if |
---|
573 | set a {} |
---|
574 | $z 1<2 {set a 1} |
---|
575 | set a |
---|
576 | } 1 |
---|
577 | test if-5.15 {if cmd with computed command names: taking proper branch} { |
---|
578 | set z if |
---|
579 | set a {} |
---|
580 | $z 1>2 {set a 1} |
---|
581 | set a |
---|
582 | } {} |
---|
583 | test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} { |
---|
584 | set z if |
---|
585 | catch {unset i} |
---|
586 | set a {} |
---|
587 | $z 1<2 { |
---|
588 | set a 1 |
---|
589 | while {$a != "xxx"} { |
---|
590 | break; |
---|
591 | while {$i >= 0} { |
---|
592 | $z {[string compare $a "bar"] < 0} { |
---|
593 | set i $i |
---|
594 | set i [lindex $s $i] |
---|
595 | } |
---|
596 | $z {[string compare $a "bar"] < 0} { |
---|
597 | set i $i |
---|
598 | set i [lindex $s $i] |
---|
599 | } |
---|
600 | $z {[string compare $a "bar"] < 0} { |
---|
601 | set i $i |
---|
602 | set i [lindex $s $i] |
---|
603 | } |
---|
604 | $z {[string compare $a "bar"] < 0} { |
---|
605 | set i $i |
---|
606 | set i [lindex $s $i] |
---|
607 | } |
---|
608 | set i [expr $i-1] |
---|
609 | } |
---|
610 | } |
---|
611 | set a 2 |
---|
612 | while {$a != "xxx"} { |
---|
613 | break; |
---|
614 | while {$i >= 0} { |
---|
615 | $z {[string compare $a "bar"] < 0} { |
---|
616 | set i $i |
---|
617 | set i [lindex $s $i] |
---|
618 | } |
---|
619 | $z {[string compare $a "bar"] < 0} { |
---|
620 | set i $i |
---|
621 | set i [lindex $s $i] |
---|
622 | } |
---|
623 | $z {[string compare $a "bar"] < 0} { |
---|
624 | set i $i |
---|
625 | set i [lindex $s $i] |
---|
626 | } |
---|
627 | $z {[string compare $a "bar"] < 0} { |
---|
628 | set i $i |
---|
629 | set i [lindex $s $i] |
---|
630 | } |
---|
631 | set i [expr $i-1] |
---|
632 | } |
---|
633 | } |
---|
634 | set a 3 |
---|
635 | } |
---|
636 | set a |
---|
637 | } 3 |
---|
638 | test if-5.17 {if cmd with computed command names: if/elseif test in quotes} { |
---|
639 | set z if |
---|
640 | set a {} |
---|
641 | list [catch {$z {"0 < 3"} {set a 1}} msg] $msg |
---|
642 | } {1 {expected boolean value but got "0 < 3"}} |
---|
643 | |
---|
644 | |
---|
645 | test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} { |
---|
646 | set z if |
---|
647 | set a {} |
---|
648 | $z 3>4 {set a 1} elseif 1 {set a 2} |
---|
649 | set a |
---|
650 | } {2} |
---|
651 | # Since "else" is optional, the "elwood" below is treated as a command. |
---|
652 | # But then there shouldn't be any additional argument words for the "if". |
---|
653 | test if-6.2 {if cmd with computed command names: keyword other than "elseif"} { |
---|
654 | set z if |
---|
655 | set a {} |
---|
656 | catch {$z 1<2 {set a 1} elwood {set a 2}} msg |
---|
657 | set msg |
---|
658 | } {wrong # args: extra words after "else" clause in "if" command} |
---|
659 | test if-6.3 {if cmd with computed command names: missing expression after "elseif"} { |
---|
660 | set z if |
---|
661 | set a {} |
---|
662 | catch {$z 1<2 {set a 1} elseif} msg |
---|
663 | set msg |
---|
664 | } {wrong # args: no expression after "elseif" argument} |
---|
665 | test if-6.4 {if cmd with computed command names: error in expression after "elseif"} -body { |
---|
666 | set z if |
---|
667 | set a {} |
---|
668 | list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $::errorInfo |
---|
669 | } -match glob -result {1 * {*"$z 3>4 {set a 1} elseif {1>}"}} |
---|
670 | test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} { |
---|
671 | set z if |
---|
672 | catch {unset i} |
---|
673 | set a {} |
---|
674 | $z 1>2 { |
---|
675 | set a 1 |
---|
676 | while {$a != "xxx"} { |
---|
677 | break; |
---|
678 | while {$i >= 0} { |
---|
679 | $z {[string compare $a "bar"] < 0} { |
---|
680 | set i $i |
---|
681 | set i [lindex $s $i] |
---|
682 | } |
---|
683 | $z {[string compare $a "bar"] < 0} { |
---|
684 | set i $i |
---|
685 | set i [lindex $s $i] |
---|
686 | } |
---|
687 | $z {[string compare $a "bar"] < 0} { |
---|
688 | set i $i |
---|
689 | set i [lindex $s $i] |
---|
690 | } |
---|
691 | $z {[string compare $a "bar"] < 0} { |
---|
692 | set i $i |
---|
693 | set i [lindex $s $i] |
---|
694 | } |
---|
695 | set i [expr $i-1] |
---|
696 | } |
---|
697 | } |
---|
698 | set a 2 |
---|
699 | while {$a != "xxx"} { |
---|
700 | break; |
---|
701 | while {$i >= 0} { |
---|
702 | $z {[string compare $a "bar"] < 0} { |
---|
703 | set i $i |
---|
704 | set i [lindex $s $i] |
---|
705 | } |
---|
706 | $z {[string compare $a "bar"] < 0} { |
---|
707 | set i $i |
---|
708 | set i [lindex $s $i] |
---|
709 | } |
---|
710 | $z {[string compare $a "bar"] < 0} { |
---|
711 | set i $i |
---|
712 | set i [lindex $s $i] |
---|
713 | } |
---|
714 | $z {[string compare $a "bar"] < 0} { |
---|
715 | set i $i |
---|
716 | set i [lindex $s $i] |
---|
717 | } |
---|
718 | set i [expr $i-1] |
---|
719 | } |
---|
720 | } |
---|
721 | set a 3 |
---|
722 | } elseif 1<2 then { #; this if arm should be taken |
---|
723 | set a 4 |
---|
724 | while {$a != "xxx"} { |
---|
725 | break; |
---|
726 | while {$i >= 0} { |
---|
727 | $z {[string compare $a "bar"] < 0} { |
---|
728 | set i $i |
---|
729 | set i [lindex $s $i] |
---|
730 | } |
---|
731 | $z {[string compare $a "bar"] < 0} { |
---|
732 | set i $i |
---|
733 | set i [lindex $s $i] |
---|
734 | } |
---|
735 | $z {[string compare $a "bar"] < 0} { |
---|
736 | set i $i |
---|
737 | set i [lindex $s $i] |
---|
738 | } |
---|
739 | $z {[string compare $a "bar"] < 0} { |
---|
740 | set i $i |
---|
741 | set i [lindex $s $i] |
---|
742 | } |
---|
743 | set i [expr $i-1] |
---|
744 | } |
---|
745 | } |
---|
746 | set a 5 |
---|
747 | while {$a != "xxx"} { |
---|
748 | break; |
---|
749 | while {$i >= 0} { |
---|
750 | $z {[string compare $a "bar"] < 0} { |
---|
751 | set i $i |
---|
752 | set i [lindex $s $i] |
---|
753 | } |
---|
754 | $z {[string compare $a "bar"] < 0} { |
---|
755 | set i $i |
---|
756 | set i [lindex $s $i] |
---|
757 | } |
---|
758 | $z {[string compare $a "bar"] < 0} { |
---|
759 | set i $i |
---|
760 | set i [lindex $s $i] |
---|
761 | } |
---|
762 | $z {[string compare $a "bar"] < 0} { |
---|
763 | set i $i |
---|
764 | set i [lindex $s $i] |
---|
765 | } |
---|
766 | set i [expr $i-1] |
---|
767 | } |
---|
768 | } |
---|
769 | set a 6 |
---|
770 | } |
---|
771 | set a |
---|
772 | } 6 |
---|
773 | |
---|
774 | test if-7.1 {if cmd with computed command names: "else" clause} { |
---|
775 | set z if |
---|
776 | set a {} |
---|
777 | $z 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3} |
---|
778 | set a |
---|
779 | } 3 |
---|
780 | # Since "else" is optional, the "elsex" below is treated as a command. |
---|
781 | # But then there shouldn't be any additional argument words for the "if". |
---|
782 | test if-7.2 {if cmd with computed command names: keyword other than "else"} { |
---|
783 | set z if |
---|
784 | set a {} |
---|
785 | catch {$z 1<2 then {set a 1} elsex {set a 2}} msg |
---|
786 | set msg |
---|
787 | } {wrong # args: extra words after "else" clause in "if" command} |
---|
788 | test if-7.3 {if cmd with computed command names: missing body after "else"} { |
---|
789 | set z if |
---|
790 | set a {} |
---|
791 | catch {$z 2<1 {set a 1} else} msg |
---|
792 | set msg |
---|
793 | } {wrong # args: no script following "else" argument} |
---|
794 | test if-7.4 {if cmd with computed command names: error compiling body after "else"} -body { |
---|
795 | set z if |
---|
796 | set a {} |
---|
797 | catch {$z 2<1 {set a 1} else {set}} msg |
---|
798 | set ::errorInfo |
---|
799 | } -match glob -result {wrong # args: should be "set varName ?newValue?" |
---|
800 | while *ing |
---|
801 | "set" |
---|
802 | invoked from within |
---|
803 | "$z 2<1 {set a 1} else {set}"} |
---|
804 | test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} { |
---|
805 | set z if |
---|
806 | set a {} |
---|
807 | catch {$z 2<1 {set a 1} else {set a 2} or something} msg |
---|
808 | set msg |
---|
809 | } {wrong # args: extra words after "else" clause in "if" command} |
---|
810 | # The following test also checks whether contained loops and other |
---|
811 | # commands are properly relocated because a short jump must be replaced |
---|
812 | # by a "long distance" one. |
---|
813 | test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} { |
---|
814 | set z if |
---|
815 | catch {unset i} |
---|
816 | set a {} |
---|
817 | $z 1>2 { |
---|
818 | set a 1 |
---|
819 | while {$a != "xxx"} { |
---|
820 | break; |
---|
821 | while {$i >= 0} { |
---|
822 | $z {[string compare $a "bar"] < 0} { |
---|
823 | set i $i |
---|
824 | set i [lindex $s $i] |
---|
825 | } |
---|
826 | $z {[string compare $a "bar"] < 0} { |
---|
827 | set i $i |
---|
828 | set i [lindex $s $i] |
---|
829 | } |
---|
830 | $z {[string compare $a "bar"] < 0} { |
---|
831 | set i $i |
---|
832 | set i [lindex $s $i] |
---|
833 | } |
---|
834 | $z {[string compare $a "bar"] < 0} { |
---|
835 | set i $i |
---|
836 | set i [lindex $s $i] |
---|
837 | } |
---|
838 | set i [expr $i-1] |
---|
839 | } |
---|
840 | } |
---|
841 | set a 2 |
---|
842 | while {$a != "xxx"} { |
---|
843 | break; |
---|
844 | while {$i >= 0} { |
---|
845 | $z {[string compare $a "bar"] < 0} { |
---|
846 | set i $i |
---|
847 | set i [lindex $s $i] |
---|
848 | } |
---|
849 | $z {[string compare $a "bar"] < 0} { |
---|
850 | set i $i |
---|
851 | set i [lindex $s $i] |
---|
852 | } |
---|
853 | $z {[string compare $a "bar"] < 0} { |
---|
854 | set i $i |
---|
855 | set i [lindex $s $i] |
---|
856 | } |
---|
857 | $z {[string compare $a "bar"] < 0} { |
---|
858 | set i $i |
---|
859 | set i [lindex $s $i] |
---|
860 | } |
---|
861 | set i [expr $i-1] |
---|
862 | } |
---|
863 | } |
---|
864 | set a 3 |
---|
865 | } elseif 1==2 then { #; this if arm should be taken |
---|
866 | set a 4 |
---|
867 | while {$a != "xxx"} { |
---|
868 | break; |
---|
869 | while {$i >= 0} { |
---|
870 | $z {[string compare $a "bar"] < 0} { |
---|
871 | set i $i |
---|
872 | set i [lindex $s $i] |
---|
873 | } |
---|
874 | $z {[string compare $a "bar"] < 0} { |
---|
875 | set i $i |
---|
876 | set i [lindex $s $i] |
---|
877 | } |
---|
878 | $z {[string compare $a "bar"] < 0} { |
---|
879 | set i $i |
---|
880 | set i [lindex $s $i] |
---|
881 | } |
---|
882 | $z {[string compare $a "bar"] < 0} { |
---|
883 | set i $i |
---|
884 | set i [lindex $s $i] |
---|
885 | } |
---|
886 | set i [expr $i-1] |
---|
887 | } |
---|
888 | } |
---|
889 | set a 5 |
---|
890 | while {$a != "xxx"} { |
---|
891 | break; |
---|
892 | while {$i >= 0} { |
---|
893 | $z {[string compare $a "bar"] < 0} { |
---|
894 | set i $i |
---|
895 | set i [lindex $s $i] |
---|
896 | } |
---|
897 | $z {[string compare $a "bar"] < 0} { |
---|
898 | set i $i |
---|
899 | set i [lindex $s $i] |
---|
900 | } |
---|
901 | $z {[string compare $a "bar"] < 0} { |
---|
902 | set i $i |
---|
903 | set i [lindex $s $i] |
---|
904 | } |
---|
905 | $z {[string compare $a "bar"] < 0} { |
---|
906 | set i $i |
---|
907 | set i [lindex $s $i] |
---|
908 | } |
---|
909 | set i [expr $i-1] |
---|
910 | } |
---|
911 | } |
---|
912 | set a 6 |
---|
913 | } else { |
---|
914 | set a 7 |
---|
915 | while {$a != "xxx"} { |
---|
916 | break; |
---|
917 | while {$i >= 0} { |
---|
918 | $z {[string compare $a "bar"] < 0} { |
---|
919 | set i $i |
---|
920 | set i [lindex $s $i] |
---|
921 | } |
---|
922 | $z {[string compare $a "bar"] < 0} { |
---|
923 | set i $i |
---|
924 | set i [lindex $s $i] |
---|
925 | } |
---|
926 | $z {[string compare $a "bar"] < 0} { |
---|
927 | set i $i |
---|
928 | set i [lindex $s $i] |
---|
929 | } |
---|
930 | $z {[string compare $a "bar"] < 0} { |
---|
931 | set i $i |
---|
932 | set i [lindex $s $i] |
---|
933 | } |
---|
934 | set i [expr $i-1] |
---|
935 | } |
---|
936 | } |
---|
937 | set a 8 |
---|
938 | while {$a != "xxx"} { |
---|
939 | break; |
---|
940 | while {$i >= 0} { |
---|
941 | $z {[string compare $a "bar"] < 0} { |
---|
942 | set i $i |
---|
943 | set i [lindex $s $i] |
---|
944 | } |
---|
945 | $z {[string compare $a "bar"] < 0} { |
---|
946 | set i $i |
---|
947 | set i [lindex $s $i] |
---|
948 | } |
---|
949 | $z {[string compare $a "bar"] < 0} { |
---|
950 | set i $i |
---|
951 | set i [lindex $s $i] |
---|
952 | } |
---|
953 | $z {[string compare $a "bar"] < 0} { |
---|
954 | set i $i |
---|
955 | set i [lindex $s $i] |
---|
956 | } |
---|
957 | set i [expr $i-1] |
---|
958 | } |
---|
959 | } |
---|
960 | set a 9 |
---|
961 | } |
---|
962 | set a |
---|
963 | } 9 |
---|
964 | |
---|
965 | test if-8.1 {if cmd with computed command names: "if" command result} { |
---|
966 | set z if |
---|
967 | set a {} |
---|
968 | set a [$z 3<4 {set i 27}] |
---|
969 | set a |
---|
970 | } 27 |
---|
971 | test if-8.2 {if cmd with computed command names: "if" command result} { |
---|
972 | set z if |
---|
973 | set a {} |
---|
974 | set a [$z 3>4 {set i 27}] |
---|
975 | set a |
---|
976 | } {} |
---|
977 | test if-8.3 {if cmd with computed command names: "if" command result} { |
---|
978 | set z if |
---|
979 | set a {} |
---|
980 | set a [$z 0 {set i 1} elseif 1 {set i 2}] |
---|
981 | set a |
---|
982 | } 2 |
---|
983 | test if-8.4 {if cmd with computed command names: "if" command result} { |
---|
984 | set z if |
---|
985 | set a {} |
---|
986 | set a [$z 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}] |
---|
987 | set a |
---|
988 | } 4 |
---|
989 | test if-8.5 {if cmd with computed command names: return value} { |
---|
990 | set z if |
---|
991 | $z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi} |
---|
992 | } def |
---|
993 | |
---|
994 | test if-9.1 {if cmd with namespace qualifiers} { |
---|
995 | ::if {1} {set x 4} |
---|
996 | } 4 |
---|
997 | |
---|
998 | # Test for incorrect "double evaluation semantics" |
---|
999 | |
---|
1000 | test if-10.1 {delayed substitution of then body} { |
---|
1001 | set j 0 |
---|
1002 | set if if |
---|
1003 | # this is not compiled |
---|
1004 | $if {[incr j] == 1} " |
---|
1005 | set result $j |
---|
1006 | " |
---|
1007 | # this will be compiled |
---|
1008 | proc p {} { |
---|
1009 | set j 0 |
---|
1010 | if {[incr j]} " |
---|
1011 | set result $j |
---|
1012 | " |
---|
1013 | set result |
---|
1014 | } |
---|
1015 | append result [p] |
---|
1016 | } {00} |
---|
1017 | test if-10.2 {delayed substitution of elseif expression} { |
---|
1018 | set j 0 |
---|
1019 | set if if |
---|
1020 | # this is not compiled |
---|
1021 | $if {[incr j] == 0} { |
---|
1022 | set result badthen |
---|
1023 | } elseif "$j == 1" { |
---|
1024 | set result badelseif |
---|
1025 | } else { |
---|
1026 | set result 0 |
---|
1027 | } |
---|
1028 | # this will be compiled |
---|
1029 | proc p {} { |
---|
1030 | set j 0 |
---|
1031 | if {[incr j] == 0} { |
---|
1032 | set result badthen |
---|
1033 | } elseif "$j == 1" { |
---|
1034 | set result badelseif |
---|
1035 | } else { |
---|
1036 | set result 0 |
---|
1037 | } |
---|
1038 | set result |
---|
1039 | } |
---|
1040 | append result [p] |
---|
1041 | } {00} |
---|
1042 | test if-10.3 {delayed substitution of elseif body} { |
---|
1043 | set j 0 |
---|
1044 | set if if |
---|
1045 | # this is not compiled |
---|
1046 | $if {[incr j] == 0} { |
---|
1047 | set result badthen |
---|
1048 | } elseif {1} " |
---|
1049 | set result $j |
---|
1050 | " |
---|
1051 | # this will be compiled |
---|
1052 | proc p {} { |
---|
1053 | set j 0 |
---|
1054 | if {[incr j] == 0} { |
---|
1055 | set result badthen |
---|
1056 | } elseif {1} " |
---|
1057 | set result $j |
---|
1058 | " |
---|
1059 | } |
---|
1060 | append result [p] |
---|
1061 | } {00} |
---|
1062 | test if-10.4 {delayed substitution of else body} { |
---|
1063 | set j 0 |
---|
1064 | if {[incr j] == 0} { |
---|
1065 | set result badthen |
---|
1066 | } else " |
---|
1067 | set result $j |
---|
1068 | " |
---|
1069 | set result |
---|
1070 | } {0} |
---|
1071 | test if-10.5 {substituted control words} { |
---|
1072 | set then then; proc then {} {return badthen} |
---|
1073 | set else else; proc else {} {return badelse} |
---|
1074 | set elseif elseif; proc elseif {} {return badelseif} |
---|
1075 | list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a |
---|
1076 | } {0 ok} |
---|
1077 | test if-10.6 {double invocation of variable traces} -body { |
---|
1078 | set iftracecounter 0 |
---|
1079 | proc iftraceproc {args} { |
---|
1080 | upvar #0 iftracecounter counter |
---|
1081 | set argc [llength $args] |
---|
1082 | set extraargs [lrange $args 0 [expr {$argc - 4}]] |
---|
1083 | set name [lindex $args [expr {$argc - 3}]] |
---|
1084 | upvar 1 $name var |
---|
1085 | if {[incr counter] % 2 == 1} { |
---|
1086 | set var "$counter oops [concat $extraargs]" |
---|
1087 | } else { |
---|
1088 | set var "$counter + [concat $extraargs]" |
---|
1089 | } |
---|
1090 | } |
---|
1091 | trace variable iftracevar r [list iftraceproc 10] |
---|
1092 | list [catch {if "$iftracevar + 20" {}} a] $a \ |
---|
1093 | [catch {if "$iftracevar + 20" {}} b] $b \ |
---|
1094 | [unset iftracevar iftracecounter] |
---|
1095 | } -match glob -result {1 {*} 0 {} {}} |
---|
1096 | |
---|
1097 | # cleanup |
---|
1098 | ::tcltest::cleanupTests |
---|
1099 | return |
---|