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