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