diff options
Diffstat (limited to 'tests/for.test')
| -rw-r--r-- | tests/for.test | 521 |
1 files changed, 469 insertions, 52 deletions
diff --git a/tests/for.test b/tests/for.test index 4fbeef7..8abd270 100644 --- a/tests/for.test +++ b/tests/for.test @@ -8,34 +8,38 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: for.test,v 1.9 2001/12/06 10:59:18 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2 namespace import -force ::tcltest::* } +# Used for constraining memory leak tests +testConstraint memory [llength [info commands memory]] +if {[testConstraint memory]} { + proc meminfo {} {lindex [split [memory info] "\n"] 3 3} +} + # Basic "for" operation. test for-1.1 {TclCompileForCmd: missing initial command} { list [catch {for} msg] $msg } {1 {wrong # args: should be "for start test next command"}} -test for-1.2 {TclCompileForCmd: error in initial command} { - list [catch {for {set}} msg] $msg $errorInfo -} {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command" - while compiling +test for-1.2 {TclCompileForCmd: error in initial command} -body { + list [catch {for {set}} msg] $msg $::errorInfo +} -match glob -result {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command" + while *ing "for {set}"}} catch {unset i} test for-1.3 {TclCompileForCmd: missing test expression} { catch {for {set i 0}} msg set msg } {wrong # args: should be "for start test next command"} -test for-1.4 {TclCompileForCmd: error in test expression} { +test for-1.4 {TclCompileForCmd: error in test expression} -body { catch {for {set i 0} {$i<}} msg - set errorInfo -} {wrong # args: should be "for start test next command" - while compiling + set ::errorInfo +} -match glob -result {wrong # args: should be "for start test next command" + while *ing "for {set i 0} {$i<}"} test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} { set i 0 @@ -49,15 +53,12 @@ test for-1.7 {TclCompileForCmd: missing command body} { catch {for {set i 0} {$i < 5} {incr i}} msg set msg } {wrong # args: should be "for start test next command"} -test for-1.8 {TclCompileForCmd: error compiling command body} { +test for-1.8 {TclCompileForCmd: error compiling command body} -body { catch {for {set i 0} {$i < 5} {incr i} {set}} msg - set errorInfo -} {wrong # args: should be "set varName ?newValue?" - while compiling -"set" - ("for" body line 1) - while compiling -"for {set i 0} {$i < 5} {incr i} {set}"} + set ::errorInfo +} -match glob -result {wrong # args: should be "set varName ?newValue?" + while *ing +"set"*} catch {unset a} test for-1.9 {TclCompileForCmd: simple command body} { set a {} @@ -83,15 +84,12 @@ test for-1.11 {TclCompileForCmd: computed command body} { for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2 set a } {x1} -test for-1.12 {TclCompileForCmd: error in "next" command} { - catch {for {set i 0} {$i < 5} {set} {puts $i}} msg - set errorInfo -} {wrong # args: should be "set varName ?newValue?" - while compiling -"set" - ("for" loop-end command) - while compiling -"for {set i 0} {$i < 5} {set} {puts $i}"} +test for-1.12 {TclCompileForCmd: error in "next" command} -body { + catch {for {set i 0} {$i < 5} {set} {format $i}} msg + set ::errorInfo +} -match glob -result {wrong # args: should be "set varName ?newValue?" + while *ing +"set"*} test for-1.13 {TclCompileForCmd: long command body} { set a {} for {set i 1} {$i<6} {set i [expr $i+1]} { @@ -205,6 +203,19 @@ test for-2.6 {continue tests, long command body} { } set a } {1 3} +test for-2.7 {continue tests, uncompiled [for]} -body { + set file [makeFile { + set guard 0 + for {set i 20} {$i > 0} {incr i -1} { + if {[incr guard]>30} {return BAD} + continue + } + return GOOD + } source.file] + source $file +} -cleanup { + removeFile source.file +} -result GOOD # Check "for" and "break". @@ -340,7 +351,6 @@ proc formatMail {} { 64 { UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \ 65 { binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \ } - set result "" set NL " " @@ -360,7 +370,6 @@ proc formatMail {} { } else { set break 1 } - set xmailer 0 set inheaders 1 set last [array size lines] @@ -381,9 +390,7 @@ proc formatMail {} { set limit 55 } else { set limit 55 - # Decide whether or not to break the body line - if {$plen > 0} { if {[string first {> } $line] == 0} { # This is quoted text from previous message, don't reformat @@ -426,7 +433,7 @@ proc formatMail {} { set climit [expr $limit-1] set cutoff 50 set continuation 0 - + while {[string length $line] > $limit} { for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} { set char [string index $line $c] @@ -656,33 +663,32 @@ test for-6.5 {Tcl_ForObjCmd: number of args} { catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg set msg } {wrong # args: should be "for start test next command"} -test for-6.6 {Tcl_ForObjCmd: error in initial command} { +test for-6.6 {Tcl_ForObjCmd: error in initial command} -body { set z for - list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $errorInfo -} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" - while compiling + list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $::errorInfo +} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" + while *ing "set" ("for" initial command) invoked from within "$z {set} {$i < 5} {incr i} {body}"}} -test for-6.7 {Tcl_ForObjCmd: error in test expression} { +test for-6.7 {Tcl_ForObjCmd: error in test expression} -body { set z for - list [catch {$z {set i 0} {i < 5} {incr i} {body}} msg] $msg $errorInfo -} {1 {syntax error in expression "i < 5": variable references require preceding $} {syntax error in expression "i < 5": variable references require preceding $ - while executing -"$z {set i 0} {i < 5} {incr i} {body}"}} + catch {$z {set i 0} {i < 5} {incr i} {body}} + set ::errorInfo +} -match glob -result {*"$z {set i 0} {i < 5} {incr i} {body}"} test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} { set z for set i 0 $z {set i 6} "$i > 5" {incr i} {set y $i} set i } 6 -test for-6.9 {Tcl_ForObjCmd: error executing command body} { +test for-6.9 {Tcl_ForObjCmd: error executing command body} -body { set z for catch {$z {set i 0} {$i < 5} {incr i} {set}} msg - set errorInfo -} {wrong # args: should be "set varName ?newValue?" - while compiling + set ::errorInfo +} -match glob -result {wrong # args: should be "set varName ?newValue?" + while *ing "set" ("for" body line 1) invoked from within @@ -714,12 +720,12 @@ test for-6.12 {Tcl_ForObjCmd: computed command body} { $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2 set a } {x1} -test for-6.13 {Tcl_ForObjCmd: error in "next" command} { +test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body { set z for catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg - set errorInfo -} {wrong # args: should be "set varName ?newValue?" - while compiling + set ::errorInfo +} -match glob -result {wrong # args: should be "set varName ?newValue?" + while *ing "set" ("for" loop-end command) invoked from within @@ -769,9 +775,420 @@ test for-6.16 {Tcl_ForObjCmd: for command result} { set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}] set a } {} +test for-6.17 {Tcl_ForObjCmd: for command result} { + list \ + [catch {for {break} {1} {} {}} err] $err \ + [catch {for {continue} {1} {} {}} err] $err \ + [catch {for {} {[break]} {} {}} err] $err \ + [catch {for {} {[continue]} {} {}} err] $err \ + [catch {for {} {1} {break} {}} err] $err \ + [catch {for {} {1} {continue} {}} err] $err \ +} [list \ + 3 {} \ + 4 {} \ + 3 {} \ + 4 {} \ + 0 {} \ + 4 {} \ + ] +test for-6.18 {Tcl_ForObjCmd: for command result} { + proc p6181 {} { + for {break} {1} {} {} + } + proc p6182 {} { + for {continue} {1} {} {} + } + proc p6183 {} { + for {} {[break]} {} {} + } + proc p6184 {} { + for {} {[continue]} {} {} + } + proc p6185 {} { + for {} {1} {break} {} + } + proc p6186 {} { + for {} {1} {continue} {} + } + list \ + [catch {p6181} err] $err \ + [catch {p6182} err] $err \ + [catch {p6183} err] $err \ + [catch {p6184} err] $err \ + [catch {p6185} err] $err \ + [catch {p6186} err] $err +} [list \ + 1 {invoked "break" outside of a loop} \ + 1 {invoked "continue" outside of a loop} \ + 1 {invoked "break" outside of a loop} \ + 1 {invoked "continue" outside of a loop} \ + 0 {} \ + 1 {invoked "continue" outside of a loop} \ + ] - - +test for-7.1 {Bug 3614226: ensure that break cleans up the stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [break] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [continue] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[break] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[continue] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.5 {Bug 3614226: ensure that break cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.6 {Bug 3614226: ensure that continue cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.7 {Bug 3614226: ensure that break only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.9 {Bug 3614226: ensure that break from invoked command cleans up the stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [apply {{} {return -code break}}] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.10 {Bug 3614226: ensure that continue from invoked command cleans up the stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [apply {{} {return -code continue}}] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[apply {{} { + return -code continue + }}] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.13 {Bug 3614226: ensure that break from invoked command cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code break + }}] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.14 {Bug 3614226: ensure that continue from invoked command cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code continue + }}] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.15 {Bug 3614226: ensure that break from invoked command only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code break + }}] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.16 {Bug 3614226: ensure that continue from invoked command only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code continue + }}] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [{*}$op] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [{*}$op] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[{*}$op] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[{*}$op] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 + # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |