tcl/tests/for.test

   1 # Commands covered:  for, continue, break
   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 #
   9 # See the file "license.terms" for information on usage and redistribution
  10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11 #
  12 # RCS: @(#) $Id$
  13
  14 if {[lsearch [namespace children] ::tcltest] == -1} {
  15     package require tcltest
  16     namespace import -force ::tcltest::*
  17 }
  18
  19 # Basic "for" operation.
  20
  21 test for-1.1 {TclCompileForCmd: missing initial command} {
  22     list [catch {for} msg] $msg
  23 } {1 {wrong # args: should be "for start test next command"}}
  24 test for-1.2 {TclCompileForCmd: error in initial command} {
  25     list [catch {for {set}} msg] $msg $errorInfo
  26 } {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
  27     while compiling
  28 "for {set}"}}
  29 catch {unset i}
  30 test for-1.3 {TclCompileForCmd: missing test expression} {
  31     catch {for {set i 0}} msg
  32     set msg
  33 } {wrong # args: should be "for start test next command"}
  34 test for-1.4 {TclCompileForCmd: error in test expression} {
  35     catch {for {set i 0} {$i<}} msg
  36     set errorInfo
  37 } {wrong # args: should be "for start test next command"
  38     while compiling
  39 "for {set i 0} {$i<}"}
  40 test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
  41     set i 0
  42     for {} "$i > 5" {incr i} {}
  43 } {}
  44 test for-1.6 {TclCompileForCmd: missing "next" command} {
  45     catch {for {set i 0} {$i < 5}} msg
  46     set msg
  47 } {wrong # args: should be "for start test next command"}
  48 test for-1.7 {TclCompileForCmd: missing command body} {
  49     catch {for {set i 0} {$i < 5} {incr i}} msg
  50     set msg
  51 } {wrong # args: should be "for start test next command"}
  52 test for-1.8 {TclCompileForCmd: error compiling command body} {
  53     catch {for {set i 0} {$i < 5} {incr i} {set}} msg
  54     set errorInfo
  55 } {wrong # args: should be "set varName ?newValue?"
  56     while compiling
  57 "set"
  58     ("for" body line 1)
  59     while compiling
  60 "for {set i 0} {$i < 5} {incr i} {set}"}
  61 catch {unset a}
  62 test for-1.9 {TclCompileForCmd: simple command body} {
  63     set a {}
  64     for {set i 1} {$i<6} {set i [expr $i+1]} {
  65         if $i==4 break
  66         set a [concat $a $i]
  67     }
  68     set a
  69 } {1 2 3}
  70 test for-1.10 {TclCompileForCmd: command body in quotes} {
  71     set a {}
  72     for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
  73     set a
  74 } {xxxxx}
  75 test for-1.11 {TclCompileForCmd: computed command body} {
  76     catch {unset x1}
  77     catch {unset bb}
  78     catch {unset x2}
  79     set x1 {append a x1; }
  80     set bb {break}
  81     set x2 {; append a x2}
  82     set a {}
  83     for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
  84     set a
  85 } {x1}
  86 test for-1.12 {TclCompileForCmd: error in "next" command} {
  87     catch {for {set i 0} {$i < 5} {set} {puts $i}} msg
  88     set errorInfo
  89 } {wrong # args: should be "set varName ?newValue?"
  90     while compiling
  91 "set"
  92     ("for" loop-end command)
  93     while compiling
  94 "for {set i 0} {$i < 5} {set} {puts $i}"}
  95 test for-1.13 {TclCompileForCmd: long command body} {
  96     set a {}
  97     for {set i 1} {$i<6} {set i [expr $i+1]} {
  98         if $i==4 break
  99         if $i>5 continue
 100         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 101             catch {set a $a} msg
 102             catch {incr i 5} msg
 103             catch {incr i -5} msg
 104         }
 105         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 106             catch {set a $a} msg
 107             catch {incr i 5} msg
 108             catch {incr i -5} msg
 109         }
 110         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 111             catch {set a $a} msg
 112             catch {incr i 5} msg
 113             catch {incr i -5} msg
 114         }
 115         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 116             catch {set a $a} msg
 117             catch {incr i 5} msg
 118             catch {incr i -5} msg
 119         }
 120         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 121             catch {set a $a} msg
 122             catch {incr i 5} msg
 123             catch {incr i -5} msg
 124         }
 125         set a [concat $a $i]
 126     }
 127     set a
 128 } {1 2 3}
 129 test for-1.14 {TclCompileForCmd: for command result} {
 130     set a [for {set i 0} {$i < 5} {incr i} {}]
 131     set a
 132 } {}
 133 test for-1.15 {TclCompileForCmd: for command result} {
 134     set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
 135     set a
 136 } {}
 137
 138 # Check "for" and "continue".
 139
 140 test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
 141     catch {continue foo} msg
 142     set msg
 143 } {wrong # args: should be "continue"}
 144 test for-2.2 {TclCompileContinueCmd: continue result} {
 145     catch continue
 146 } 4
 147 test for-2.3 {continue tests} {
 148     set a {}
 149     for {set i 1} {$i <= 4} {set i [expr $i+1]} {
 150         if {$i == 2} continue
 151         set a [concat $a $i]
 152     }
 153     set a
 154 } {1 3 4}
 155 test for-2.4 {continue tests} {
 156     set a {}
 157     for {set i 1} {$i <= 4} {set i [expr $i+1]} {
 158         if {$i != 2} continue
 159         set a [concat $a $i]
 160     }
 161     set a
 162 } {2}
 163 test for-2.5 {continue tests, nested loops} {
 164     set msg {}
 165     for {set i 1} {$i <= 4} {incr i} {
 166         for {set a 1} {$a <= 2} {incr a} {
 167             if {$i>=2 && $a>=2} continue
 168             set msg [concat $msg "$i.$a"]
 169         }
 170     }
 171     set msg
 172 } {1.1 1.2 2.1 3.1 4.1}
 173 test for-2.6 {continue tests, long command body} {
 174     set a {}
 175     for {set i 1} {$i<6} {set i [expr $i+1]} {
 176         if $i==2 continue
 177         if $i==4 break
 178         if $i>5 continue
 179         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 180             catch {set a $a} msg
 181             catch {incr i 5} msg
 182             catch {incr i -5} msg
 183         }
 184         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 185             catch {set a $a} msg
 186             catch {incr i 5} msg
 187             catch {incr i -5} msg
 188         }
 189         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 190             catch {set a $a} msg
 191             catch {incr i 5} msg
 192             catch {incr i -5} msg
 193         }
 194         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 195             catch {set a $a} msg
 196             catch {incr i 5} msg
 197             catch {incr i -5} msg
 198         }
 199         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 200             catch {set a $a} msg
 201             catch {incr i 5} msg
 202             catch {incr i -5} msg
 203         }
 204         set a [concat $a $i]
 205     }
 206     set a
 207 } {1 3}
 208
 209 # Check "for" and "break".
 210
 211 test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
 212     catch {break foo} msg
 213     set msg
 214 } {wrong # args: should be "break"}
 215 test for-3.2 {TclCompileBreakCmd: break result} {
 216     catch break
 217 } 3
 218 test for-3.3 {break tests} {
 219     set a {}
 220     for {set i 1} {$i <= 4} {incr i} {
 221         if {$i == 3} break
 222         set a [concat $a $i]
 223     }
 224     set a
 225 } {1 2}
 226 test for-3.4 {break tests, nested loops} {
 227     set msg {}
 228     for {set i 1} {$i <= 4} {incr i} {
 229         for {set a 1} {$a <= 2} {incr a} {
 230             if {$i>=2 && $a>=2} break
 231             set msg [concat $msg "$i.$a"]
 232         }
 233     }
 234     set msg
 235 } {1.1 1.2 2.1 3.1 4.1}
 236 test for-3.5 {break tests, long command body} {
 237     set a {}
 238     for {set i 1} {$i<6} {set i [expr $i+1]} {
 239         if $i==2 continue
 240         if $i==5 break
 241         if $i>5 continue
 242         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 243             catch {set a $a} msg
 244             catch {incr i 5} msg
 245             catch {incr i -5} msg
 246         }
 247         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 248             catch {set a $a} msg
 249             catch {incr i 5} msg
 250             catch {incr i -5} msg
 251         }
 252         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 253             catch {set a $a} msg
 254             catch {incr i 5} msg
 255             catch {incr i -5} msg
 256         }
 257         if $i==4 break
 258         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 259             catch {set a $a} msg
 260             catch {incr i 5} msg
 261             catch {incr i -5} msg
 262         }
 263         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 264             catch {set a $a} msg
 265             catch {incr i 5} msg
 266             catch {incr i -5} msg
 267         }
 268         set a [concat $a $i]
 269     }
 270     set a
 271 } {1 3}
 272 # A simplified version of exmh's mail formatting routine to stress "for",
 273 # "break", "while", and "if".
 274 proc formatMail {} {
 275     array set lines {
 276         0 {Return-path: george@tcl} \
 277         1 {Return-path: <george@tcl>} \
 278         2 {Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)} \
 279         3 {     id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700} \
 280         4 {Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>} \
 281         5 {X-mailer: exmh version 1.6.9 8/22/96} \
 282         6 {Mime-version: 1.0} \
 283         7 {Content-type: text/plain; charset=iso-8859-1} \
 284         8 {Content-transfer-encoding: quoted-printable} \
 285         9 {Content-length: 2162} \
 286         10 {To: fred} \
 287         11 {Subject: tcl7.6} \
 288         12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \
 289         13 {From: George <george@tcl>} \
 290         14 {The Tcl 7.6 and Tk 4.2 releases} \
 291         15 {} \
 292         16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \
 293         17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \
 294         18 {releases were released on August 30, 1996. These releases contain only minor changes,} \
 295         19 {so we hope to have only a single beta release and to go final in early October, 1996. } \
 296         20 {} \
 297         21 {} \
 298         22 {What's new } \
 299         23 {} \
 300         24 {The most important changes in the releases are summarized below. See the README} \
 301         25 {and changes files in the distributions for more complete information on what has} \
 302         26 {changed, including both feature changes and bug fixes. } \
 303         27 {} \
 304         28 {     There are new options to the file command for copying files (file copy),} \
 305         29 {     deleting files and directories (file delete), creating directories (file} \
 306         30 {     mkdir), and renaming files (file rename). } \
 307         31 {     The implementation of exec has been improved greatly for Windows 95 and} \
 308         32 {     Windows NT. } \
 309         33 {     There is a new memory allocator for the Macintosh version, which should be} \
 310         34 {     more efficient than the old one. } \
 311         35 {     Tk's grid geometry manager has been completely rewritten. The layout} \
 312         36 {     algorithm produces much better layouts than before, especially where rows or} \
 313         37 {     columns were stretchable. } \
 314         38 {     There are new commands for creating common dialog boxes:} \
 315         39 {     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \
 316         40 {     tk_messageBox. These use native dialog boxes if they are available. } \
 317         41 {     There is a new virtual event mechanism for handling events in a more portable} \
 318         42 {     way. See the new command event. It also allows events (both physical and} \
 319         43 {     virtual) to be generated dynamically. } \
 320         44 {} \
 321         45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \
 322         46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
 323         47 {should work on these new releases as well. } \
 324         48 {} \
 325         49 {Obtaining The Releases} \
 326         50 {} \
 327         51 {Binary Releases} \
 328         52 {} \
 329         53 {Pre-compiled releases are available for the following platforms: } \
 330         54 {} \
 331         55 {     Windows 3.1, Windows 95, and Windows NT: Fetch} \
 332         56 {     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
 333         57 {     self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
 334         58 {     tclsh programs, and documentation. } \
 335         59 {     Macintosh (both 68K and PowerPC): Fetch} \
 336         60 {     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
 337         61 {     which is understood by Fetch, StuffIt, and many other Mac utilities. The} \
 338         62 {     unpacked file is a self-installing executable: double-click on it and it will create a} \
 339         63 {     folder containing all that you need to run Tcl and Tk. } \
 340         64 {        UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
 341         65 {     binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
 342     }
 343
 344     set result ""
 345     set NL "
 346 "
 347     set tag {level= type=text/plain part=0 sel Charset}
 348     set ix [lsearch -regexp $tag text/enriched]
 349     if {$ix < 0} {
 350         set ranges {}
 351         set quote 0
 352     }
 353     set breakrange {6.42 78.0}
 354     set F1 [lindex $breakrange 0]
 355     set F2 [lindex $breakrange 1]
 356     set breakrange [lrange $breakrange 2 end]
 357     if {[string length $F1] == 0} {
 358         set F1 -1
 359         set break 0
 360     } else {
 361         set break 1
 362     }
 363
 364     set xmailer 0
 365     set inheaders 1
 366     set last [array size lines]
 367     set plen 2
 368     for {set L 1} {$L < $last} {incr L} {
 369         set line $lines($L)
 370         if {$inheaders} {
 371             # Blank or empty line terminates headers
 372             # Leading --- terminates headers
 373             if {[regexp {^[     ]*$} $line] || [regexp {^--+} $line]} {
 374                 set inheaders 0
 375             }
 376             if {[regexp -nocase {^x-mailer:} $line]} {
 377                 continue
 378             }
 379         }
 380         if $inheaders {
 381             set limit 55
 382         } else {
 383             set limit 55
 384
 385             # Decide whether or not to break the body line
 386
 387             if {$plen > 0} {
 388                 if {[string first {> } $line] == 0} {
 389                     # This is quoted text from previous message, don't reformat
 390                     append result $line $NL
 391                     if {$quote && !$inheaders} {
 392                         # Fix from <sarr@umich.edu> to handle text/enriched
 393                         if {$L > $L1 && $L < $L2 && $line != {}} {
 394                             # enriched requires two newlines for each one.
 395                             append result $NL
 396                         } elseif {$L > $L2} {
 397                             set L1 [lindex $ranges 0]
 398                             set L2 [lindex $ranges 1]
 399                             set ranges [lrange $ranges 2 end]
 400                             set quote [llength $L1]
 401                         }
 402                     }
 403                     continue
 404                 }
 405             }
 406             if {$F1 < 0} {
 407                 # Nothing left to format
 408                 append result $line $NL
 409                 continue
 410             } elseif {$L < $F1} {
 411                 # Not yet to formatted block
 412                 append result $line $NL
 413                 continue
 414             } elseif {$L > $F2} {
 415                 # Past formatted block
 416                 set F1 [lindex $breakrange 0]
 417                 set F2 [lindex $breakrange 1]
 418                 set breakrange [lrange $breakrange 2 end]
 419                 append result $line $NL
 420                 if {[string length $F1] == 0} {
 421                     set F1 -1
 422                 }
 423                 continue
 424             }
 425         }
 426         set climit [expr $limit-1]
 427         set cutoff 50
 428         set continuation 0
 429
 430         while {[string length $line] > $limit} {
 431             for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} {
 432                 set char [string index $line $c]
 433                 if {$char == " " || $char == "\t"} {
 434                     break
 435                 }
 436                 if {$char == ">"} {     ;# Hack for enriched formatting
 437                     break
 438                 }
 439             }
 440             if {$c < $cutoff} {
 441                 if {! $inheaders} {
 442                     set c [expr $limit-1]
 443                 } else {
 444                     set c [string length $line]
 445                 }
 446             }
 447             set newline [string range $line 0 $c]
 448             if {! $continuation} {
 449                 append result $newline $NL
 450             } else {
 451                 append result \ $newline $NL
 452             }
 453             incr c
 454             set line [string trimright [string range $line $c end]]
 455             if {$inheaders} {
 456                 set continuation 1
 457                 set limit $climit
 458             }
 459         }
 460         if {$continuation} {
 461             if {[string length $line] != 0} {
 462                 append result \ $line $NL
 463             }
 464         } else {
 465             append result $line $NL
 466             if {$quote && !$inheaders} {
 467                 if {$L > $L1 && $L < $L2 && $line != {}} {
 468                     # enriched requires two newlines for each one.
 469                     append result "" $NL
 470                 } elseif {$L > $L2} {
 471                     set L1 [lindex $ranges 0]
 472                     set L2 [lindex $ranges 1]
 473                     set ranges [lrange $ranges 2 end]
 474                     set quote [llength $L1]
 475                 }
 476             }
 477         }
 478     }
 479     return $result
 480 }
 481 test for-3.6 {break tests} {
 482     formatMail
 483 } {Return-path: <george@tcl>
 484 Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)
 485         id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700
 486 Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>
 487 Mime-version: 1.0
 488 Content-type: text/plain; charset=iso-8859-1
 489 Content-transfer-encoding: quoted-printable
 490 Content-length: 2162
 491 To: fred
 492 Subject: tcl7.6
 493 Date: Wed, 11 Sep 1996 11:14:53 -0700
 494 From: George <george@tcl>
 495 The Tcl 7.6 and Tk 4.2 releases
 496
 497 This page contains information about Tcl 7.6 and Tk4.2,
 498  which are the most recent
 499 releases of the Tcl scripting language and the Tk toolk
 500 it. The first beta versions of these
 501 releases were released on August 30, 1996. These releas
 502 es contain only minor changes,
 503 so we hope to have only a single beta release and to
 504 go final in early October, 1996.
 505
 506
 507 What's new
 508
 509 The most important changes in the releases are summariz
 510 ed below. See the README
 511 and changes files in the distributions for more complet
 512 e information on what has
 513 changed, including both feature changes and bug fixes.
 514
 515      There are new options to the file command for
 516 copying files (file copy),
 517      deleting files and directories (file delete),
 518 creating directories (file
 519      mkdir), and renaming files (file rename).
 520      The implementation of exec has been improved great
 521 ly for Windows 95 and
 522      Windows NT.
 523      There is a new memory allocator for the Macintosh
 524 version, which should be
 525      more efficient than the old one.
 526      Tk's grid geometry manager has been completely
 527 rewritten. The layout
 528      algorithm produces much better layouts than before
 529 , especially where rows or
 530      columns were stretchable.
 531      There are new commands for creating common dialog
 532 boxes:
 533      tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
 534      tk_messageBox. These use native dialog boxes if
 535 they are available.
 536      There is a new virtual event mechanism for handlin
 537 g events in a more portable
 538      way. See the new command event. It also allows
 539 events (both physical and
 540      virtual) to be generated dynamically.
 541
 542 Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
 543 7.5 and Tk 4.1 except for
 544 changes in the C APIs for custom channel drivers. Scrip
 545 ts written for earlier releases
 546 should work on these new releases as well.
 547
 548 Obtaining The Releases
 549
 550 Binary Releases
 551
 552 Pre-compiled releases are available for the following
 553 platforms:
 554
 555      Windows 3.1, Windows 95, and Windows NT: Fetch
 556      ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
 557 execute it. The file is a
 558      self-extracting executable. It will install the
 559 Tcl and Tk libraries, the wish and
 560      tclsh programs, and documentation.
 561      Macintosh (both 68K and PowerPC): Fetch
 562      ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
 563 The file is in binhex format,
 564      which is understood by Fetch, StuffIt, and many
 565 other Mac utilities. The
 566      unpacked file is a self-installing executable:
 567 double-click on it and it will create a
 568      folder containing all that you need to run Tcl
 569 and Tk.
 570         UNIX (Solaris 2.* and SunOS, other systems
 571 soon to follow). Easy to install
 572      binary packages are now for sale at the Sun Labs
 573 Tcl/Tk Shop. Check it out!
 574 }
 575
 576 # Check that "break" resets the interpreter's result
 577
 578 test for-4.1 {break must reset the interp result} {
 579     catch {
 580         set z GLOBTESTDIR/dir2/file2.c
 581         if [string match GLOBTESTDIR/dir2/* $z] {
 582             break
 583         }
 584     } j
 585     set j
 586 } {}
 587
 588 # Test for incorrect "double evaluation" semantics
 589
 590 test for-5.1 {possible delayed substitution of increment command} {
 591     # Increment should be 5, and lappend should always append $a
 592     catch {unset a}
 593     catch {unset i}
 594     set a 5
 595     set i {}
 596     for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
 597     set i
 598 } {1 6 11}
 599
 600 test for-5.2 {possible delayed substitution of increment command} {
 601     # Increment should be 5, and lappend should always append $a
 602     catch {rename p ""}
 603     proc p {} {
 604         set a 5
 605         set i {}
 606         for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
 607         set i
 608     }
 609     p
 610 } {1 6 11}
 611 test for-5.3 {possible delayed substitution of body command} {
 612     # Increment should be $a, and lappend should always append 5
 613     set a 5
 614     set i {}
 615     for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
 616     set i
 617 } {5 5 5 5}
 618 test for-5.4 {possible delayed substitution of body command} {
 619     # Increment should be $a, and lappend should always append 5
 620     catch {rename p ""}
 621     proc p {} {
 622         set a 5
 623         set i {}
 624         for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
 625         set i
 626     }
 627     p
 628 } {5 5 5 5}
 629
 630 # In the following tests we need to bypass the bytecode compiler by
 631 # substituting the command from a variable.  This ensures that command
 632 # procedure is invoked directly.
 633
 634 test for-6.1 {Tcl_ForObjCmd: number of args} {
 635     set z for
 636     catch {$z} msg
 637     set msg
 638 } {wrong # args: should be "for start test next command"}
 639 test for-6.2 {Tcl_ForObjCmd: number of args} {
 640     set z for
 641     catch {$z {set i 0}} msg
 642     set msg
 643 } {wrong # args: should be "for start test next command"}
 644 test for-6.3 {Tcl_ForObjCmd: number of args} {
 645     set z for
 646     catch {$z {set i 0} {$i < 5}} msg
 647     set msg
 648 } {wrong # args: should be "for start test next command"}
 649 test for-6.4 {Tcl_ForObjCmd: number of args} {
 650     set z for
 651     catch {$z {set i 0} {$i < 5} {incr i}} msg
 652     set msg
 653 } {wrong # args: should be "for start test next command"}
 654 test for-6.5 {Tcl_ForObjCmd: number of args} {
 655     set z for
 656     catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
 657     set msg
 658 } {wrong # args: should be "for start test next command"}
 659 test for-6.6 {Tcl_ForObjCmd: error in initial command} {
 660     set z for
 661     list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $errorInfo
 662 } {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
 663     while compiling
 664 "set"
 665     ("for" initial command)
 666     invoked from within
 667 "$z {set} {$i < 5} {incr i} {body}"}}
 668 test for-6.7 {Tcl_ForObjCmd: error in test expression} {
 669     set z for
 670     list [catch {$z {set i 0} {i < 5} {incr i} {body}} msg] $msg $errorInfo
 671 } {1 {syntax error in expression "i < 5": variable references require preceding $} {syntax error in expression "i < 5": variable references require preceding $
 672     while executing
 673 "$z {set i 0} {i < 5} {incr i} {body}"}}
 674 test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
 675     set z for
 676     set i 0
 677     $z {set i 6} "$i > 5" {incr i} {set y $i}
 678     set i
 679 } 6
 680 test for-6.9 {Tcl_ForObjCmd: error executing command body} {
 681     set z for
 682     catch {$z {set i 0} {$i < 5} {incr i} {set}} msg
 683     set errorInfo
 684 } {wrong # args: should be "set varName ?newValue?"
 685     while compiling
 686 "set"
 687     ("for" body line 1)
 688     invoked from within
 689 "$z {set i 0} {$i < 5} {incr i} {set}"}
 690 test for-6.10 {Tcl_ForObjCmd: simple command body} {
 691     set z for
 692     set a {}
 693     $z {set i 1} {$i<6} {set i [expr $i+1]} {
 694         if $i==4 break
 695         set a [concat $a $i]
 696     }
 697     set a
 698 } {1 2 3}
 699 test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
 700     set z for
 701     set a {}
 702     $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
 703     set a
 704 } {xxxxx}
 705 test for-6.12 {Tcl_ForObjCmd: computed command body} {
 706     set z for
 707     catch {unset x1}
 708     catch {unset bb}
 709     catch {unset x2}
 710     set x1 {append a x1; }
 711     set bb {break}
 712     set x2 {; append a x2}
 713     set a {}
 714     $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
 715     set a
 716 } {x1}
 717 test for-6.13 {Tcl_ForObjCmd: error in "next" command} {
 718     set z for
 719     catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
 720     set errorInfo
 721 } {wrong # args: should be "set varName ?newValue?"
 722     while compiling
 723 "set"
 724     ("for" loop-end command)
 725     invoked from within
 726 "$z {set i 0} {$i < 5} {set} {set j 4}"}
 727 test for-6.14 {Tcl_ForObjCmd: long command body} {
 728     set z for
 729     set a {}
 730     $z {set i 1} {$i<6} {set i [expr $i+1]} {
 731         if $i==4 break
 732         if $i>5 continue
 733         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 734             catch {set a $a} msg
 735             catch {incr i 5} msg
 736             catch {incr i -5} msg
 737         }
 738         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 739             catch {set a $a} msg
 740             catch {incr i 5} msg
 741             catch {incr i -5} msg
 742         }
 743         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 744             catch {set a $a} msg
 745             catch {incr i 5} msg
 746             catch {incr i -5} msg
 747         }
 748         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 749             catch {set a $a} msg
 750             catch {incr i 5} msg
 751             catch {incr i -5} msg
 752         }
 753         if {$i>6 && $tcl_platform(machine)=="xxx"} {
 754             catch {set a $a} msg
 755             catch {incr i 5} msg
 756             catch {incr i -5} msg
 757         }
 758         set a [concat $a $i]
 759     }
 760     set a
 761 } {1 2 3}
 762 test for-6.15 {Tcl_ForObjCmd: for command result} {
 763     set z for
 764     set a [$z {set i 0} {$i < 5} {incr i} {}]
 765     set a
 766 } {}
 767 test for-6.16 {Tcl_ForObjCmd: for command result} {
 768     set z for
 769     set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
 770     set a
 771 } {}
 772
 773
 774
 775 # cleanup
 776 ::tcltest::cleanupTests
 777 return