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