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