Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/tests/if.test @ 47

Last change on this file since 47 was 25, checked in by landauf, 17 years ago

added tcl to libs

File size: 26.2 KB
Line 
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
15if {[lsearch [namespace children] ::tcltest] == -1} {
16    package require tcltest 2
17    namespace import -force ::tcltest::*
18}
19
20# Basic "if" operation.
21
22catch {unset a}
23test if-1.1 {TclCompileIfCmd: missing if/elseif test} {
24    list [catch {if} msg] $msg
25} {1 {wrong # args: no expression after "if" argument}}
26test 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}}
29test 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+}"}}
32test if-1.4 {TclCompileIfCmd: if/elseif test in braces} {
33    set a {}
34    if {1<2} {set a 1}
35    set a
36} {1}
37test 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}
42test 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
48test 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}
53test 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"}
58test 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}
63test 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"*}}
69test 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}}
72test if-1.12 {TclCompileIfCmd: "then" body in quotes} {
73    set a {}
74    if 27>17 "append a x"
75    set a
76} {x}
77test 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}
87test if-1.14 {TclCompileIfCmd: taking proper branch} {
88    set a {}
89    if 1<2 {set a 1}
90    set a
91} 1
92test if-1.15 {TclCompileIfCmd: taking proper branch} {
93    set a {}
94    if 1>2 {set a 1}
95    set a
96} {}
97test 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
151test 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
157test 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".
164test 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}
169test 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}
174test 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>}"}}
178test 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
281test 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".
288test 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}
293test 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}
298test 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"*}
305test 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.
313test 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
464test if-4.1 {TclCompileIfCmd: "if" command result} {
465    set a {}
466    set a [if 3<4 {set i 27}]
467    set a
468} 27
469test if-4.2 {TclCompileIfCmd: "if" command result} {
470    set a {}
471    set a [if 3>4 {set i 27}]
472    set a
473} {}
474test 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
479test 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
484test 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
490catch {unset a}
491test 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
496test 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}}
500test 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+}"}}
504test 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}
510test 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}
516test 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
523test 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}
529test 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"}
535test 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}
541test 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}"}}
550test 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}}
554test 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}
560test 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}
571test 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
577test 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} {}
583test 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
638test 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
645test 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".
653test 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}
659test 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}
665test 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>}"}}
670test 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
774test 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".
782test 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}
788test 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}
794test 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}"}
804test 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.
813test 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
965test 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
971test 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} {}
977test 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
983test 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
989test 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
994test 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
1000test 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}
1017test 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}
1042test 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}
1062test 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}
1071test 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}
1077test 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
1099return
Note: See TracBrowser for help on using the repository browser.