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 © 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 12if {"::tcltest" ni [namespace children]} { 13 package require tcltest 2.5 14 namespace import -force ::tcltest::* 15} 16 17# Used for constraining memory leak tests 18testConstraint memory [llength [info commands memory]] 19if {[testConstraint memory]} { 20 proc meminfo {} {lindex [split [memory info] "\n"] 3 3} 21} 22 23# Basic "for" operation. 24 25test for-1.1 {TclCompileForCmd: missing initial command} { 26 list [catch {for} msg] $msg 27} {1 {wrong # args: should be "for start test next command"}} 28test for-1.2 {TclCompileForCmd: error in initial command} -body { 29 list [catch {for {set}} msg] $msg $::errorInfo 30} -match glob -result {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command" 31 while *ing 32"for {set}"}} 33catch {unset i} 34test for-1.3 {TclCompileForCmd: missing test expression} { 35 catch {for {set i 0}} msg 36 set msg 37} {wrong # args: should be "for start test next command"} 38test for-1.4 {TclCompileForCmd: error in test expression} -body { 39 catch {for {set i 0} {$i<}} msg 40 set ::errorInfo 41} -match glob -result {wrong # args: should be "for start test next command" 42 while *ing 43"for {set i 0} {$i<}"} 44test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} { 45 set i 0 46 for {} "$i > 5" {incr i} {} 47} {} 48test for-1.6 {TclCompileForCmd: missing "next" command} { 49 catch {for {set i 0} {$i < 5}} msg 50 set msg 51} {wrong # args: should be "for start test next command"} 52test for-1.7 {TclCompileForCmd: missing command body} { 53 catch {for {set i 0} {$i < 5} {incr i}} msg 54 set msg 55} {wrong # args: should be "for start test next command"} 56test for-1.8 {TclCompileForCmd: error compiling command body} -body { 57 catch {for {set i 0} {$i < 5} {incr i} {set}} msg 58 set ::errorInfo 59} -match glob -result {wrong # args: should be "set varName ?newValue?" 60 while *ing 61"set"*} 62catch {unset a} 63test for-1.9 {TclCompileForCmd: simple command body} { 64 set a {} 65 for {set i 1} {$i<6} {incr i} { 66 if {$i==4} break 67 set a [concat $a $i] 68 } 69 set a 70} {1 2 3} 71test for-1.10 {TclCompileForCmd: command body in quotes} { 72 set a {} 73 for {set i 1} {$i<6} {incr i} "append a x" 74 set a 75} {xxxxx} 76test for-1.11 {TclCompileForCmd: computed command body} { 77 catch {unset x1} 78 catch {unset bb} 79 catch {unset x2} 80 set x1 {append a x1; } 81 set bb {break} 82 set x2 {; append a x2} 83 set a {} 84 for {set i 1} {$i<6} {incr i} $x1$bb$x2 85 set a 86} {x1} 87test for-1.12 {TclCompileForCmd: error in "next" command} -body { 88 catch {for {set i 0} {$i < 5} {set} {format $i}} msg 89 set ::errorInfo 90} -match glob -result {wrong # args: should be "set varName ?newValue?" 91 while *ing 92"set"*} 93test for-1.13 {TclCompileForCmd: long command body} { 94 set a {} 95 for {set i 1} {$i<6} {incr i} { 96 if {$i==4} break 97 if {$i>5} continue 98 if {$i>6 && $tcl_platform(machine)=="xxx"} { 99 catch {set a $a} msg 100 catch {incr i 5} msg 101 catch {incr i -5} msg 102 } 103 if {$i>6 && $tcl_platform(machine)=="xxx"} { 104 catch {set a $a} msg 105 catch {incr i 5} msg 106 catch {incr i -5} msg 107 } 108 if {$i>6 && $tcl_platform(machine)=="xxx"} { 109 catch {set a $a} msg 110 catch {incr i 5} msg 111 catch {incr i -5} msg 112 } 113 if {$i>6 && $tcl_platform(machine)=="xxx"} { 114 catch {set a $a} msg 115 catch {incr i 5} msg 116 catch {incr i -5} msg 117 } 118 if {$i>6 && $tcl_platform(machine)=="xxx"} { 119 catch {set a $a} msg 120 catch {incr i 5} msg 121 catch {incr i -5} msg 122 } 123 set a [concat $a $i] 124 } 125 set a 126} {1 2 3} 127test for-1.14 {TclCompileForCmd: for command result} { 128 set a [for {set i 0} {$i < 5} {incr i} {}] 129 set a 130} {} 131test for-1.15 {TclCompileForCmd: for command result} { 132 set a [for {set i 0} {$i < 5} {incr i} {if {$i==3} break}] 133 set a 134} {} 135 136# Check "for" and "continue". 137 138test for-2.1 {TclCompileContinueCmd: arguments after "continue"} { 139 catch {continue foo} msg 140 set msg 141} {wrong # args: should be "continue"} 142test for-2.2 {TclCompileContinueCmd: continue result} { 143 catch continue 144} 4 145test for-2.3 {continue tests} { 146 set a {} 147 for {set i 1} {$i <= 4} {incr i} { 148 if {$i == 2} continue 149 set a [concat $a $i] 150 } 151 set a 152} {1 3 4} 153test for-2.4 {continue tests} { 154 set a {} 155 for {set i 1} {$i <= 4} {incr i} { 156 if {$i != 2} continue 157 set a [concat $a $i] 158 } 159 set a 160} {2} 161test for-2.5 {continue tests, nested loops} { 162 set msg {} 163 for {set i 1} {$i <= 4} {incr i} { 164 for {set a 1} {$a <= 2} {incr a} { 165 if {$i>=2 && $a>=2} continue 166 set msg [concat $msg "$i.$a"] 167 } 168 } 169 set msg 170} {1.1 1.2 2.1 3.1 4.1} 171test for-2.6 {continue tests, long command body} { 172 set a {} 173 for {set i 1} {$i<6} {incr i} { 174 if {$i==2} continue 175 if {$i==4} break 176 if {$i>5} continue 177 if {$i>6 && $tcl_platform(machine)=="xxx"} { 178 catch {set a $a} msg 179 catch {incr i 5} msg 180 catch {incr i -5} msg 181 } 182 if {$i>6 && $tcl_platform(machine)=="xxx"} { 183 catch {set a $a} msg 184 catch {incr i 5} msg 185 catch {incr i -5} msg 186 } 187 if {$i>6 && $tcl_platform(machine)=="xxx"} { 188 catch {set a $a} msg 189 catch {incr i 5} msg 190 catch {incr i -5} msg 191 } 192 if {$i>6 && $tcl_platform(machine)=="xxx"} { 193 catch {set a $a} msg 194 catch {incr i 5} msg 195 catch {incr i -5} msg 196 } 197 if {$i>6 && $tcl_platform(machine)=="xxx"} { 198 catch {set a $a} msg 199 catch {incr i 5} msg 200 catch {incr i -5} msg 201 } 202 set a [concat $a $i] 203 } 204 set a 205} {1 3} 206test for-2.7 {continue tests, uncompiled [for]} -body { 207 set file [makeFile { 208 set guard 0 209 for {set i 20} {$i > 0} {incr i -1} { 210 if {[incr guard]>30} {return BAD} 211 continue 212 } 213 return GOOD 214 } source.file] 215 source $file 216} -cleanup { 217 removeFile source.file 218} -result GOOD 219 220# Check "for" and "break". 221 222test for-3.1 {TclCompileBreakCmd: arguments after "break"} { 223 catch {break foo} msg 224 set msg 225} {wrong # args: should be "break"} 226test for-3.2 {TclCompileBreakCmd: break result} { 227 catch break 228} 3 229test for-3.3 {break tests} { 230 set a {} 231 for {set i 1} {$i <= 4} {incr i} { 232 if {$i == 3} break 233 set a [concat $a $i] 234 } 235 set a 236} {1 2} 237test for-3.4 {break tests, nested loops} { 238 set msg {} 239 for {set i 1} {$i <= 4} {incr i} { 240 for {set a 1} {$a <= 2} {incr a} { 241 if {$i>=2 && $a>=2} break 242 set msg [concat $msg "$i.$a"] 243 } 244 } 245 set msg 246} {1.1 1.2 2.1 3.1 4.1} 247test for-3.5 {break tests, long command body} { 248 set a {} 249 for {set i 1} {$i<6} {incr i} { 250 if {$i==2} continue 251 if {$i==5} break 252 if {$i>5} continue 253 if {$i>6 && $tcl_platform(machine)=="xxx"} { 254 catch {set a $a} msg 255 catch {incr i 5} msg 256 catch {incr i -5} msg 257 } 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 if {$i==4} break 269 if {$i>6 && $tcl_platform(machine)=="xxx"} { 270 catch {set a $a} msg 271 catch {incr i 5} msg 272 catch {incr i -5} msg 273 } 274 if {$i>6 && $tcl_platform(machine)=="xxx"} { 275 catch {set a $a} msg 276 catch {incr i 5} msg 277 catch {incr i -5} msg 278 } 279 set a [concat $a $i] 280 } 281 set a 282} {1 3} 283# A simplified version of exmh's mail formatting routine to stress "for", 284# "break", "while", and "if". 285proc formatMail {} { 286 array set lines { 287 0 {Return-path: george@tcl} \ 288 1 {Return-path: <george@tcl>} \ 289 2 {Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)} \ 290 3 { id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700} \ 291 4 {Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>} \ 292 5 {X-mailer: exmh version 1.6.9 8/22/96} \ 293 6 {Mime-version: 1.0} \ 294 7 {Content-type: text/plain; charset=iso-8859-1} \ 295 8 {Content-transfer-encoding: quoted-printable} \ 296 9 {Content-length: 2162} \ 297 10 {To: fred} \ 298 11 {Subject: tcl7.6} \ 299 12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \ 300 13 {From: George <george@tcl>} \ 301 14 {The Tcl 7.6 and Tk 4.2 releases} \ 302 15 {} \ 303 16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \ 304 17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \ 305 18 {releases were released on August 30, 1996. These releases contain only minor changes,} \ 306 19 {so we hope to have only a single beta release and to go final in early October, 1996.} \ 307 20 {} \ 308 21 {} \ 309 22 {What's new} \ 310 23 {} \ 311 24 {The most important changes in the releases are summarized below. See the README} \ 312 25 {and changes files in the distributions for more complete information on what has} \ 313 26 {changed, including both feature changes and bug fixes.} \ 314 27 {} \ 315 28 { There are new options to the file command for copying files (file copy),} \ 316 29 { deleting files and directories (file delete), creating directories (file} \ 317 30 { mkdir), and renaming files (file rename).} \ 318 31 { The implementation of exec has been improved greatly for Windows 95 and} \ 319 32 { Windows NT.} \ 320 33 { There is a new memory allocator for the Macintosh version, which should be} \ 321 34 { more efficient than the old one.} \ 322 35 { Tk's grid geometry manager has been completely rewritten. The layout} \ 323 36 { algorithm produces much better layouts than before, especially where rows or} \ 324 37 { columns were stretchable.} \ 325 38 { There are new commands for creating common dialog boxes:} \ 326 39 { tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \ 327 40 { tk_messageBox. These use native dialog boxes if they are available.} \ 328 41 { There is a new virtual event mechanism for handling events in a more portable} \ 329 42 { way. See the new command event. It also allows events (both physical and} \ 330 43 { virtual) to be generated dynamically.} \ 331 44 {} \ 332 45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \ 333 46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \ 334 47 {should work on these new releases as well.} \ 335 48 {} \ 336 49 {Obtaining The Releases} \ 337 50 {} \ 338 51 {Binary Releases} \ 339 52 {} \ 340 53 {Pre-compiled releases are available for the following platforms: } \ 341 54 {} \ 342 55 { Windows 3.1, Windows 95, and Windows NT: Fetch} \ 343 56 { ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \ 344 57 { self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \ 345 58 { tclsh programs, and documentation.} \ 346 59 { Macintosh (both 68K and PowerPC): Fetch} \ 347 60 { ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \ 348 61 { which is understood by Fetch, StuffIt, and many other Mac utilities. The} \ 349 62 { unpacked file is a self-installing executable: double-click on it and it will create a} \ 350 63 { folder containing all that you need to run Tcl and Tk. } \ 351 64 { UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \ 352 65 { binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \ 353 } 354 set result "" 355 set NL " 356" 357 set tag {level= type=text/plain part=0 sel Charset} 358 set ix [lsearch -regexp $tag text/enriched] 359 if {$ix < 0} { 360 set ranges {} 361 set quote 0 362 } 363 set breakrange {6.42 78.0} 364 set F1 [lindex $breakrange 0] 365 set F2 [lindex $breakrange 1] 366 set breakrange [lrange $breakrange 2 end] 367 if {[string length $F1] == 0} { 368 set F1 -1 369 set break 0 370 } else { 371 set break 1 372 } 373 set xmailer 0 374 set inheaders 1 375 set last [array size lines] 376 set plen 2 377 for {set L 1} {$L < $last} {incr L} { 378 set line $lines($L) 379 if {$inheaders} { 380 # Blank or empty line terminates headers 381 # Leading --- terminates headers 382 if {[regexp {^[ ]*$} $line] || [regexp {^--+} $line]} { 383 set inheaders 0 384 } 385 if {[regexp -nocase {^x-mailer:} $line]} { 386 continue 387 } 388 } 389 if {$inheaders} { 390 set limit 55 391 } else { 392 set limit 55 393 # Decide whether or not to break the body line 394 if {$plen > 0} { 395 if {[string first {> } $line] == 0} { 396 # This is quoted text from previous message, don't reformat 397 append result $line $NL 398 if {$quote && !$inheaders} { 399 # Fix from <sarr@umich.edu> to handle text/enriched 400 if {$L > $L1 && $L < $L2 && $line != {}} { 401 # enriched requires two newlines for each one. 402 append result $NL 403 } elseif {$L > $L2} { 404 set L1 [lindex $ranges 0] 405 set L2 [lindex $ranges 1] 406 set ranges [lrange $ranges 2 end] 407 set quote [llength $L1] 408 } 409 } 410 continue 411 } 412 } 413 if {$F1 < 0} { 414 # Nothing left to format 415 append result $line $NL 416 continue 417 } elseif {$L < $F1} { 418 # Not yet to formatted block 419 append result $line $NL 420 continue 421 } elseif {$L > $F2} { 422 # Past formatted block 423 set F1 [lindex $breakrange 0] 424 set F2 [lindex $breakrange 1] 425 set breakrange [lrange $breakrange 2 end] 426 append result $line $NL 427 if {[string length $F1] == 0} { 428 set F1 -1 429 } 430 continue 431 } 432 } 433 set climit [expr {$limit-1}] 434 set cutoff 50 435 set continuation 0 436 437 while {[string length $line] > $limit} { 438 for {set c [expr {$limit-1}]} {$c >= $cutoff} {incr c -1} { 439 set char [string index $line $c] 440 if {$char == " " || $char == "\t"} { 441 break 442 } 443 if {$char == ">"} { ;# Hack for enriched formatting 444 break 445 } 446 } 447 if {$c < $cutoff} { 448 if {! $inheaders} { 449 set c [expr {$limit-1}] 450 } else { 451 set c [string length $line] 452 } 453 } 454 set newline [string trimright [string range $line 0 $c]] 455 if {! $continuation} { 456 append result $newline $NL 457 } else { 458 append result \ $newline $NL 459 } 460 incr c 461 set line [string trimright [string range $line $c end]] 462 if {$inheaders} { 463 set continuation 1 464 set limit $climit 465 } 466 } 467 if {$continuation} { 468 if {[string length $line] != 0} { 469 append result \ $line $NL 470 } 471 } else { 472 append result $line $NL 473 if {$quote && !$inheaders} { 474 if {$L > $L1 && $L < $L2 && $line != {}} { 475 # enriched requires two newlines for each one. 476 append result "" $NL 477 } elseif {$L > $L2} { 478 set L1 [lindex $ranges 0] 479 set L2 [lindex $ranges 1] 480 set ranges [lrange $ranges 2 end] 481 set quote [llength $L1] 482 } 483 } 484 } 485 } 486 return $result 487} 488test for-3.6 {break tests} { 489 formatMail 490} {Return-path: <george@tcl> 491Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4) 492 id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700 493Message-id: <199609111814.LAA10027@tcl.Somewhere.COM> 494Mime-version: 1.0 495Content-type: text/plain; charset=iso-8859-1 496Content-transfer-encoding: quoted-printable 497Content-length: 2162 498To: fred 499Subject: tcl7.6 500Date: Wed, 11 Sep 1996 11:14:53 -0700 501From: George <george@tcl> 502The Tcl 7.6 and Tk 4.2 releases 503 504This page contains information about Tcl 7.6 and Tk4.2, 505 which are the most recent 506releases of the Tcl scripting language and the Tk toolk 507it. The first beta versions of these 508releases were released on August 30, 1996. These releas 509es contain only minor changes, 510so we hope to have only a single beta release and to 511go final in early October, 1996. 512 513 514What's new 515 516The most important changes in the releases are summariz 517ed below. See the README 518and changes files in the distributions for more complet 519e information on what has 520changed, including both feature changes and bug fixes. 521 522 There are new options to the file command for 523copying files (file copy), 524 deleting files and directories (file delete), 525creating directories (file 526 mkdir), and renaming files (file rename). 527 The implementation of exec has been improved great 528ly for Windows 95 and 529 Windows NT. 530 There is a new memory allocator for the Macintosh 531version, which should be 532 more efficient than the old one. 533 Tk's grid geometry manager has been completely 534rewritten. The layout 535 algorithm produces much better layouts than before 536, especially where rows or 537 columns were stretchable. 538 There are new commands for creating common dialog 539boxes: 540 tk_chooseColor, tk_getOpenFile, tk_getSaveFile and 541 tk_messageBox. These use native dialog boxes if 542they are available. 543 There is a new virtual event mechanism for handlin 544g events in a more portable 545 way. See the new command event. It also allows 546events (both physical and 547 virtual) to be generated dynamically. 548 549Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 5507.5 and Tk 4.1 except for 551changes in the C APIs for custom channel drivers. Scrip 552ts written for earlier releases 553should work on these new releases as well. 554 555Obtaining The Releases 556 557Binary Releases 558 559Pre-compiled releases are available for the following 560platforms: 561 562 Windows 3.1, Windows 95, and Windows NT: Fetch 563 ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then 564execute it. The file is a 565 self-extracting executable. It will install the 566Tcl and Tk libraries, the wish and 567 tclsh programs, and documentation. 568 Macintosh (both 68K and PowerPC): Fetch 569 ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. 570The file is in binhex format, 571 which is understood by Fetch, StuffIt, and many 572other Mac utilities. The 573 unpacked file is a self-installing executable: 574double-click on it and it will create a 575 folder containing all that you need to run Tcl 576and Tk. 577 UNIX (Solaris 2.* and SunOS, other systems 578soon to follow). Easy to install 579 binary packages are now for sale at the Sun Labs 580Tcl/Tk Shop. Check it out! 581} 582 583# Check that "break" resets the interpreter's result 584 585test for-4.1 {break must reset the interp result} { 586 catch { 587 set z GLOBTESTDIR/dir2/file2.c 588 if {[string match GLOBTESTDIR/dir2/* $z]} { 589 break 590 } 591 } j 592 set j 593} {} 594 595# Test for incorrect "double evaluation" semantics 596 597test for-5.1 {possible delayed substitution of increment command} { 598 # Increment should be 5, and lappend should always append $a 599 catch {unset a} 600 catch {unset i} 601 set a 5 602 set i {} 603 for {set a 1} {$a < 12} "incr a $a" {lappend i $a} 604 set i 605} {1 6 11} 606 607test for-5.2 {possible delayed substitution of increment command} { 608 # Increment should be 5, and lappend should always append $a 609 catch {rename p ""} 610 proc p {} { 611 set a 5 612 set i {} 613 for {set a 1} {$a < 12} "incr a $a" {lappend i $a} 614 set i 615 } 616 p 617} {1 6 11} 618test for-5.3 {possible delayed substitution of body command} { 619 # Increment should be $a, and lappend should always append 5 620 set a 5 621 set i {} 622 for {set a 1} {$a < 12} {incr a $a} "lappend i $a" 623 set i 624} {5 5 5 5} 625test for-5.4 {possible delayed substitution of body command} { 626 # Increment should be $a, and lappend should always append 5 627 catch {rename p ""} 628 proc p {} { 629 set a 5 630 set i {} 631 for {set a 1} {$a < 12} {incr a $a} "lappend i $a" 632 set i 633 } 634 p 635} {5 5 5 5} 636 637# In the following tests we need to bypass the bytecode compiler by 638# substituting the command from a variable. This ensures that command 639# procedure is invoked directly. 640 641test for-6.1 {Tcl_ForObjCmd: number of args} { 642 set z for 643 catch {$z} msg 644 set msg 645} {wrong # args: should be "for start test next command"} 646test for-6.2 {Tcl_ForObjCmd: number of args} { 647 set z for 648 catch {$z {set i 0}} msg 649 set msg 650} {wrong # args: should be "for start test next command"} 651test for-6.3 {Tcl_ForObjCmd: number of args} { 652 set z for 653 catch {$z {set i 0} {$i < 5}} msg 654 set msg 655} {wrong # args: should be "for start test next command"} 656test for-6.4 {Tcl_ForObjCmd: number of args} { 657 set z for 658 catch {$z {set i 0} {$i < 5} {incr i}} msg 659 set msg 660} {wrong # args: should be "for start test next command"} 661test for-6.5 {Tcl_ForObjCmd: number of args} { 662 set z for 663 catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg 664 set msg 665} {wrong # args: should be "for start test next command"} 666test for-6.6 {Tcl_ForObjCmd: error in initial command} -body { 667 set z for 668 list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $::errorInfo 669} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" 670 while *ing 671"set" 672 ("for" initial command) 673 invoked from within 674"$z {set} {$i < 5} {incr i} {body}"}} 675test for-6.7 {Tcl_ForObjCmd: error in test expression} -body { 676 set z for 677 catch {$z {set i 0} {i < 5} {incr i} {body}} 678 set ::errorInfo 679} -match glob -result {*"$z {set i 0} {i < 5} {incr i} {body}"} 680test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} { 681 set z for 682 set i 0 683 $z {set i 6} "$i > 5" {incr i} {set y $i} 684 set i 685} 6 686test for-6.9 {Tcl_ForObjCmd: error executing command body} -body { 687 set z for 688 catch {$z {set i 0} {$i < 5} {incr i} {set}} msg 689 set ::errorInfo 690} -match glob -result {wrong # args: should be "set varName ?newValue?" 691 while *ing 692"set" 693 ("for" body line 1) 694 invoked from within 695"$z {set i 0} {$i < 5} {incr i} {set}"} 696test for-6.10 {Tcl_ForObjCmd: simple command body} { 697 set z for 698 set a {} 699 $z {set i 1} {$i<6} {incr i} { 700 if {$i==4} break 701 set a [concat $a $i] 702 } 703 set a 704} {1 2 3} 705test for-6.11 {Tcl_ForObjCmd: command body in quotes} { 706 set z for 707 set a {} 708 $z {set i 1} {$i<6} {incr i} "append a x" 709 set a 710} {xxxxx} 711test for-6.12 {Tcl_ForObjCmd: computed command body} { 712 set z for 713 catch {unset x1} 714 catch {unset bb} 715 catch {unset x2} 716 set x1 {append a x1; } 717 set bb {break} 718 set x2 {; append a x2} 719 set a {} 720 $z {set i 1} {$i<6} {incr i} $x1$bb$x2 721 set a 722} {x1} 723test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body { 724 set z for 725 catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg 726 set ::errorInfo 727} -match glob -result {wrong # args: should be "set varName ?newValue?" 728 while *ing 729"set" 730 ("for" loop-end command) 731 invoked from within 732"$z {set i 0} {$i < 5} {set} {set j 4}"} 733test for-6.14 {Tcl_ForObjCmd: long command body} { 734 set z for 735 set a {} 736 $z {set i 1} {$i<6} {incr i} { 737 if {$i==4} break 738 if {$i>5} continue 739 if {$i>6 && $tcl_platform(machine)=="xxx"} { 740 catch {set a $a} msg 741 catch {incr i 5} msg 742 catch {incr i -5} msg 743 } 744 if {$i>6 && $tcl_platform(machine)=="xxx"} { 745 catch {set a $a} msg 746 catch {incr i 5} msg 747 catch {incr i -5} msg 748 } 749 if {$i>6 && $tcl_platform(machine)=="xxx"} { 750 catch {set a $a} msg 751 catch {incr i 5} msg 752 catch {incr i -5} msg 753 } 754 if {$i>6 && $tcl_platform(machine)=="xxx"} { 755 catch {set a $a} msg 756 catch {incr i 5} msg 757 catch {incr i -5} msg 758 } 759 if {$i>6 && $tcl_platform(machine)=="xxx"} { 760 catch {set a $a} msg 761 catch {incr i 5} msg 762 catch {incr i -5} msg 763 } 764 set a [concat $a $i] 765 } 766 set a 767} {1 2 3} 768test for-6.15 {Tcl_ForObjCmd: for command result} { 769 set z for 770 set a [$z {set i 0} {$i < 5} {incr i} {}] 771 set a 772} {} 773test for-6.16 {Tcl_ForObjCmd: for command result} { 774 set z for 775 set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}] 776 set a 777} {} 778test for-6.17 {Tcl_ForObjCmd: for command result} { 779 list \ 780 [catch {for {break} {1} {} {}} err] $err \ 781 [catch {for {continue} {1} {} {}} err] $err \ 782 [catch {for {} {[break]} {} {}} err] $err \ 783 [catch {for {} {[continue]} {} {}} err] $err \ 784 [catch {for {} {1} {break} {}} err] $err \ 785 [catch {for {} {1} {continue} {}} err] $err \ 786} [list \ 787 3 {} \ 788 4 {} \ 789 3 {} \ 790 4 {} \ 791 0 {} \ 792 4 {} \ 793 ] 794test for-6.18 {Tcl_ForObjCmd: for command result} { 795 proc p6181 {} { 796 for {break} {1} {} {} 797 } 798 proc p6182 {} { 799 for {continue} {1} {} {} 800 } 801 proc p6183 {} { 802 for {} {[break]} {} {} 803 } 804 proc p6184 {} { 805 for {} {[continue]} {} {} 806 } 807 proc p6185 {} { 808 for {} {1} {break} {} 809 } 810 proc p6186 {} { 811 for {} {1} {continue} {} 812 } 813 list \ 814 [catch {p6181} err] $err \ 815 [catch {p6182} err] $err \ 816 [catch {p6183} err] $err \ 817 [catch {p6184} err] $err \ 818 [catch {p6185} err] $err \ 819 [catch {p6186} err] $err 820} [list \ 821 1 {invoked "break" outside of a loop} \ 822 1 {invoked "continue" outside of a loop} \ 823 1 {invoked "break" outside of a loop} \ 824 1 {invoked "continue" outside of a loop} \ 825 0 {} \ 826 1 {invoked "continue" outside of a loop} \ 827 ] 828 829test for-7.1 {Bug 3614226: ensure that break cleans up the stack} memory { 830 apply {{} { 831 # Can't use [memtest]; must be careful when we change stack frames 832 set end [meminfo] 833 for {set i 0} {$i < 5} {incr i} { 834 for {set x 0} {$x < 5} {incr x} { 835 list a b c [break] d e f 836 } 837 set tmp $end 838 set end [meminfo] 839 } 840 expr {$end - $tmp} 841 }} 842} 0 843test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory { 844 apply {{} { 845 # Can't use [memtest]; must be careful when we change stack frames 846 set end [meminfo] 847 for {set i 0} {$i < 5} {incr i} { 848 for {set x 0} {$x < 5} {incr x} { 849 list a b c [continue] d e f 850 } 851 set tmp $end 852 set end [meminfo] 853 } 854 expr {$end - $tmp} 855 }} 856} 0 857test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} memory { 858 apply {{} { 859 # Can't use [memtest]; must be careful when we change stack frames 860 set end [meminfo] 861 for {set i 0} {$i < 5} {incr i} { 862 for {set x 0} {[incr x]<50} {} { 863 puts {*}[puts a b c {*}[break] d e f] 864 } 865 set tmp $end 866 set end [meminfo] 867 } 868 expr {$end - $tmp} 869 }} 870} 0 871test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} memory { 872 apply {{} { 873 # Can't use [memtest]; must be careful when we change stack frames 874 set end [meminfo] 875 for {set i 0} {$i < 5} {incr i} { 876 for {set x 0} {[incr x]<50} {} { 877 puts {*}[puts a b c {*}[continue] d e f] 878 } 879 set tmp $end 880 set end [meminfo] 881 } 882 expr {$end - $tmp} 883 }} 884} 0 885test for-7.5 {Bug 3614226: ensure that break cleans up the combination of main and expansion stack} memory { 886 apply {{} { 887 set l [lrepeat 50 p q r] 888 # Can't use [memtest]; must be careful when we change stack frames 889 set end [meminfo] 890 for {set i 0} {$i < 5} {incr i} { 891 for {set x 0} {[incr x]<50} {} { 892 puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] 893 } 894 set tmp $end 895 set end [meminfo] 896 } 897 expr {$end - $tmp} 898 }} 899} 0 900test for-7.6 {Bug 3614226: ensure that continue cleans up the combination of main and expansion stack} memory { 901 apply {{} { 902 set l [lrepeat 50 p q r] 903 # Can't use [memtest]; must be careful when we change stack frames 904 set end [meminfo] 905 for {set i 0} {$i < 5} {incr i} { 906 for {set x 0} {[incr x]<50} {} { 907 puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] 908 } 909 set tmp $end 910 set end [meminfo] 911 } 912 expr {$end - $tmp} 913 }} 914} 0 915test for-7.7 {Bug 3614226: ensure that break only cleans up the right amount} memory { 916 apply {{} { 917 set l [lrepeat 50 p q r] 918 # Can't use [memtest]; must be careful when we change stack frames 919 set end [meminfo] 920 for {set i 0} {$i < 5} {incr i} { 921 unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { 922 puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] 923 }] 924 set tmp $end 925 set end [meminfo] 926 } 927 expr {$end - $tmp} 928 }} 929} 0 930test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} memory { 931 apply {{} { 932 set l [lrepeat 50 p q r] 933 # Can't use [memtest]; must be careful when we change stack frames 934 set end [meminfo] 935 for {set i 0} {$i < 5} {incr i} { 936 unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { 937 puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] 938 }] 939 set tmp $end 940 set end [meminfo] 941 } 942 expr {$end - $tmp} 943 }} 944} 0 945test for-7.9 {Bug 3614226: ensure that break from invoked command cleans up the stack} memory { 946 apply {{} { 947 # Can't use [memtest]; must be careful when we change stack frames 948 set end [meminfo] 949 for {set i 0} {$i < 5} {incr i} { 950 for {set x 0} {$x < 5} {incr x} { 951 list a b c [apply {{} {return -code break}}] d e f 952 } 953 set tmp $end 954 set end [meminfo] 955 } 956 expr {$end - $tmp} 957 }} 958} 0 959test for-7.10 {Bug 3614226: ensure that continue from invoked command cleans up the stack} memory { 960 apply {{} { 961 # Can't use [memtest]; must be careful when we change stack frames 962 set end [meminfo] 963 for {set i 0} {$i < 5} {incr i} { 964 for {set x 0} {$x < 5} {incr x} { 965 list a b c [apply {{} {return -code continue}}] d e f 966 } 967 set tmp $end 968 set end [meminfo] 969 } 970 expr {$end - $tmp} 971 }} 972} 0 973test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion stack} memory { 974 apply {{} { 975 # Can't use [memtest]; must be careful when we change stack frames 976 set end [meminfo] 977 for {set i 0} {$i < 5} {incr i} { 978 for {set x 0} {[incr x]<50} {} { 979 puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f] 980 } 981 set tmp $end 982 set end [meminfo] 983 } 984 expr {$end - $tmp} 985 }} 986} 0 987test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion stack} memory { 988 apply {{} { 989 # Can't use [memtest]; must be careful when we change stack frames 990 set end [meminfo] 991 for {set i 0} {$i < 5} {incr i} { 992 for {set x 0} {[incr x]<50} {} { 993 puts {*}[puts a b c {*}[apply {{} { 994 return -code continue 995 }}] d e f] 996 } 997 set tmp $end 998 set end [meminfo] 999 } 1000 expr {$end - $tmp} 1001 }} 1002} 0 1003test for-7.13 {Bug 3614226: ensure that break from invoked command cleans up the combination of main and expansion stack} memory { 1004 apply {{} { 1005 set l [lrepeat 50 p q r] 1006 # Can't use [memtest]; must be careful when we change stack frames 1007 set end [meminfo] 1008 for {set i 0} {$i < 5} {incr i} { 1009 for {set x 0} {[incr x]<50} {} { 1010 puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { 1011 return -code break 1012 }}] d e f]] 1013 } 1014 set tmp $end 1015 set end [meminfo] 1016 } 1017 expr {$end - $tmp} 1018 }} 1019} 0 1020test for-7.14 {Bug 3614226: ensure that continue from invoked command cleans up the combination of main and expansion stack} memory { 1021 apply {{} { 1022 set l [lrepeat 50 p q r] 1023 # Can't use [memtest]; must be careful when we change stack frames 1024 set end [meminfo] 1025 for {set i 0} {$i < 5} {incr i} { 1026 for {set x 0} {[incr x]<50} {} { 1027 puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { 1028 return -code continue 1029 }}] d e f]] 1030 } 1031 set tmp $end 1032 set end [meminfo] 1033 } 1034 expr {$end - $tmp} 1035 }} 1036} 0 1037test for-7.15 {Bug 3614226: ensure that break from invoked command only cleans up the right amount} memory { 1038 apply {{} { 1039 set l [lrepeat 50 p q r] 1040 # Can't use [memtest]; must be careful when we change stack frames 1041 set end [meminfo] 1042 for {set i 0} {$i < 5} {incr i} { 1043 unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { 1044 puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { 1045 return -code break 1046 }}] d e f]] 1047 }] 1048 set tmp $end 1049 set end [meminfo] 1050 } 1051 expr {$end - $tmp} 1052 }} 1053} 0 1054test for-7.16 {Bug 3614226: ensure that continue from invoked command only cleans up the right amount} memory { 1055 apply {{} { 1056 set l [lrepeat 50 p q r] 1057 # Can't use [memtest]; must be careful when we change stack frames 1058 set end [meminfo] 1059 for {set i 0} {$i < 5} {incr i} { 1060 unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { 1061 puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { 1062 return -code continue 1063 }}] d e f]] 1064 }] 1065 set tmp $end 1066 set end [meminfo] 1067 } 1068 expr {$end - $tmp} 1069 }} 1070} 0 1071test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory { 1072 apply {op { 1073 # Can't use [memtest]; must be careful when we change stack frames 1074 set end [meminfo] 1075 for {set i 0} {$i < 5} {incr i} { 1076 for {set x 0} {$x < 5} {incr x} { 1077 list a b c [{*}$op] d e f 1078 } 1079 set tmp $end 1080 set end [meminfo] 1081 } 1082 expr {$end - $tmp} 1083 }} {return -level 0 -code break} 1084} 0 1085test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory { 1086 apply {op { 1087 # Can't use [memtest]; must be careful when we change stack frames 1088 set end [meminfo] 1089 for {set i 0} {$i < 5} {incr i} { 1090 for {set x 0} {$x < 5} {incr x} { 1091 list a b c [{*}$op] d e f 1092 } 1093 set tmp $end 1094 set end [meminfo] 1095 } 1096 expr {$end - $tmp} 1097 }} {return -level 0 -code continue} 1098} 0 1099test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory { 1100 apply {op { 1101 # Can't use [memtest]; must be careful when we change stack frames 1102 set end [meminfo] 1103 for {set i 0} {$i < 5} {incr i} { 1104 for {set x 0} {[incr x]<50} {} { 1105 puts {*}[puts a b c {*}[{*}$op] d e f] 1106 } 1107 set tmp $end 1108 set end [meminfo] 1109 } 1110 expr {$end - $tmp} 1111 }} {return -level 0 -code break} 1112} 0 1113test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory { 1114 apply {op { 1115 # Can't use [memtest]; must be careful when we change stack frames 1116 set end [meminfo] 1117 for {set i 0} {$i < 5} {incr i} { 1118 for {set x 0} {[incr x]<50} {} { 1119 puts {*}[puts a b c {*}[{*}$op] d e f] 1120 } 1121 set tmp $end 1122 set end [meminfo] 1123 } 1124 expr {$end - $tmp} 1125 }} {return -level 0 -code continue} 1126} 0 1127test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory { 1128 apply {op { 1129 set l [lrepeat 50 p q r] 1130 # Can't use [memtest]; must be careful when we change stack frames 1131 set end [meminfo] 1132 for {set i 0} {$i < 5} {incr i} { 1133 for {set x 0} {[incr x]<50} {} { 1134 puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] 1135 } 1136 set tmp $end 1137 set end [meminfo] 1138 } 1139 expr {$end - $tmp} 1140 }} {return -level 0 -code break} 1141} 0 1142test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory { 1143 apply {op { 1144 set l [lrepeat 50 p q r] 1145 # Can't use [memtest]; must be careful when we change stack frames 1146 set end [meminfo] 1147 for {set i 0} {$i < 5} {incr i} { 1148 for {set x 0} {[incr x]<50} {} { 1149 puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] 1150 } 1151 set tmp $end 1152 set end [meminfo] 1153 } 1154 expr {$end - $tmp} 1155 }} {return -level 0 -code continue} 1156} 0 1157test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory { 1158 apply {op { 1159 set l [lrepeat 50 p q r] 1160 # Can't use [memtest]; must be careful when we change stack frames 1161 set end [meminfo] 1162 for {set i 0} {$i < 5} {incr i} { 1163 unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { 1164 puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] 1165 }] 1166 set tmp $end 1167 set end [meminfo] 1168 } 1169 expr {$end - $tmp} 1170 }} {return -level 0 -code break} 1171} 0 1172test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory { 1173 apply {op { 1174 set l [lrepeat 50 p q r] 1175 # Can't use [memtest]; must be careful when we change stack frames 1176 set end [meminfo] 1177 for {set i 0} {$i < 5} {incr i} { 1178 unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { 1179 puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] 1180 }] 1181 set tmp $end 1182 set end [meminfo] 1183 } 1184 expr {$end - $tmp} 1185 }} {return -level 0 -code continue} 1186} 0 1187 1188test for-8.0 {Coverity CID 1251203: break vs continue in for-step clause} { 1189 apply {{} { 1190 for {set k 0} {$k < 3} {incr k} { 1191 set j 0 1192 list a [\ 1193 for {set i 0} {$i < 5} {incr i; list a [eval {}]} { 1194 incr j 1195 }] 1196 incr i 1197 } 1198 list $i $j $k 1199 }} 1200} {6 5 3} 1201test for-8.1 {Coverity CID 1251203: break vs continue in for-step clause} { 1202 apply {{} { 1203 for {set k 0} {$k < 3} {incr k} { 1204 set j 0 1205 list a [\ 1206 for {set i 0} {$i < 5} {incr i;list a [eval break]} { 1207 incr j 1208 }] 1209 incr i 1210 } 1211 list $i $j $k 1212 }} 1213} {2 1 3} 1214test for-8.2 {Coverity CID 1251203: break vs continue in for-step clause} { 1215 apply {{} { 1216 for {set k 0} {$k < 3} {incr k} { 1217 set j 0 1218 list a [\ 1219 for {set i 0} {$i < 5} {incr i;list a [eval continue]} { 1220 incr j 1221 }] 1222 incr i 1223 } 1224 list $i $j $k 1225 }} 1226} {1 1 3} 1227test for-8.3 {break in for-step clause} { 1228 apply {{} { 1229 for {set k 0} {$k < 3} {incr k} { 1230 set j 0 1231 list a [\ 1232 for {set i 0} {$i < 5} {incr i; break} { 1233 incr j 1234 }] 1235 incr i 1236 } 1237 list $i $j $k 1238 }} 1239} {2 1 3} 1240test for-8.4 {continue in for-step clause} { 1241 apply {{} { 1242 for {set k 0} {$k < 3} {incr k} { 1243 set j 0 1244 list a [\ 1245 for {set i 0} {$i < 5} {incr i; continue} { 1246 incr j 1247 }] 1248 incr i 1249 } 1250 list $i $j $k 1251 }} 1252} {1 1 3} 1253test for-8.5 {break in for-step clause} { 1254 apply {{} { 1255 for {set k 0} {$k < 3} {incr k} { 1256 set j 0 1257 list a [\ 1258 for {set i 0} {$i < 5} {incr i; list a [break]} { 1259 incr j 1260 }] 1261 incr i 1262 } 1263 list $i $j $k 1264 }} 1265} {2 1 3} 1266test for-8.6 {continue in for-step clause} { 1267 apply {{} { 1268 for {set k 0} {$k < 3} {incr k} { 1269 set j 0 1270 list a [\ 1271 for {set i 0} {$i < 5} {incr i; list a [continue]} { 1272 incr j 1273 }] 1274 incr i 1275 } 1276 list $i $j $k 1277 }} 1278} {1 1 3} 1279test for-8.7 {break in for-step clause} { 1280 apply {{} { 1281 for {set k 0} {$k < 3} {incr k} { 1282 set j 0 1283 list a [\ 1284 for {set i 0} {$i < 5} {incr i;eval break} { 1285 incr j 1286 }] 1287 incr i 1288 } 1289 list $i $j $k 1290 }} 1291} {2 1 3} 1292test for-8.8 {continue in for-step clause} { 1293 apply {{} { 1294 for {set k 0} {$k < 3} {incr k} { 1295 set j 0 1296 list a [\ 1297 for {set i 0} {$i < 5} {incr i;eval continue} { 1298 incr j 1299 }] 1300 incr i 1301 } 1302 list $i $j $k 1303 }} 1304} {1 1 3} 1305test for-8.9 {break in for-step clause} { 1306 apply {{} { 1307 for {set k 0} {$k < 3} {incr k} { 1308 set j 0 1309 for {set i 0} {$i < 5} {incr i;eval break} { 1310 incr j 1311 } 1312 incr i 1313 } 1314 list $i $j $k 1315 }} 1316} {2 1 3} 1317test for-8.10 {continue in for-step clause} { 1318 apply {{} { 1319 for {set k 0} {$k < 3} {incr k} { 1320 set j 0 1321 for {set i 0} {$i < 5} {incr i;eval continue} { 1322 incr j 1323 } 1324 incr i 1325 } 1326 list $i $j $k 1327 }} 1328} {1 1 3} 1329test for-8.11 {break in for-step clause} { 1330 apply {{} { 1331 for {set k 0} {$k < 3} {incr k} { 1332 set j 0 1333 for {set i 0} {$i < 5} {incr i;break} { 1334 incr j 1335 } 1336 incr i 1337 } 1338 list $i $j $k 1339 }} 1340} {2 1 3} 1341test for-8.12 {continue in for-step clause} { 1342 apply {{} { 1343 for {set k 0} {$k < 3} {incr k} { 1344 set j 0 1345 for {set i 0} {$i < 5} {incr i;continue} { 1346 incr j 1347 } 1348 incr i 1349 } 1350 list $i $j $k 1351 }} 1352} {1 1 3} 1353 1354# cleanup 1355::tcltest::cleanupTests 1356return 1357 1358# Local Variables: 1359# mode: tcl 1360# End: 1361