diff options
| -rw-r--r-- | tests/while.test | 375 |
1 files changed, 229 insertions, 146 deletions
diff --git a/tests/while.test b/tests/while.test index 5aadd10..323e160 100644 --- a/tests/while.test +++ b/tests/while.test @@ -1,18 +1,18 @@ # Commands covered: while # -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: while.test,v 1.13 2006/10/09 19:15:45 msofer Exp $ +# RCS: @(#) $Id: while.test,v 1.14 2009/10/30 16:28:02 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } @@ -22,29 +22,31 @@ if {[lsearch [namespace children] ::tcltest] == -1} { catch {unset i} catch {unset a} -test while-1.1 {TclCompileWhileCmd: missing test expression} { - catch {while } msg - set msg -} {wrong # args: should be "while test command"} +test while-1.1 {TclCompileWhileCmd: missing test expression} -body { + while +} -returnCodes error -result {wrong # args: should be "while test command"} test while-1.2 {TclCompileWhileCmd: error in test expression} -body { set i 0 - catch {while {$i<} break} msg - set ::errorInfo + catch {while {$i<} break} + return $::errorInfo +} -cleanup { + unset i } -match glob -result {*"while {$i<} break"} -test while-1.3 {TclCompileWhileCmd: error in test expression} { - set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] - list $err $msg -} {1 {can't use non-numeric string as operand of "+"}} -test while-1.4 {TclCompileWhileCmd: multiline test expr} { +test while-1.3 {TclCompileWhileCmd: error in test expression} -body { + while {"a"+"b"} {error "loop aborted"} +} -returnCodes error -result {can't use non-numeric string as operand of "+"} +test while-1.4 {TclCompileWhileCmd: multiline test expr} -body { set value 1 while {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} { incr value break } - set value -} {2} -test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} { + return $value +} -cleanup { + unset value +} -result {2} +test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} -body { set value 1 while {"true"} { incr value; @@ -52,25 +54,28 @@ test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} { break; } } - set value -} 6 + return $value +} -cleanup { + unset value +} -result 6 test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} { set i 0 while "$i > 5" {} } {} -test while-1.7 {TclCompileWhileCmd: missing command body} { +test while-1.7 {TclCompileWhileCmd: missing command body} -body { set i 0 - catch {while {$i < 5} } msg - set msg -} {wrong # args: should be "while test command"} + while {$i < 5} +} -returnCodes error -result {wrong # args: should be "while test command"} test while-1.8 {TclCompileWhileCmd: error compiling command body} -body { set i 0 - catch {while {$i < 5} {set}} msg - set ::errorInfo -} -match glob -result {wrong # args: should be "set varName ?newValue?" + catch {while {$i < 5} {set}} + return $::errorInfo +} -match glob -cleanup { + unset i +} -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} -test while-1.9 {TclCompileWhileCmd: simple command body} { +test while-1.9 {TclCompileWhileCmd: simple command body} -body { set a {} set i 1 while {$i<6} { @@ -78,27 +83,34 @@ test while-1.9 {TclCompileWhileCmd: simple command body} { set a [concat $a $i] incr i } - set a -} {1 2 3} -test while-1.10 {TclCompileWhileCmd: command body in quotes} { + return $a +} -cleanup { + unset a i +} -result {1 2 3} +test while-1.10 {TclCompileWhileCmd: command body in quotes} -body { set a {} set i 1 while {$i<6} "append a x; incr i" - set a -} {xxxxx} -test while-1.11 {TclCompileWhileCmd: computed command body} { + return $a +} -cleanup { + unset a i +} -result {xxxxx} +test while-1.11 {TclCompileWhileCmd: computed command body} -setup { catch {unset x1} catch {unset bb} catch {unset x2} +} -body { set x1 {append a x1; } set bb {break} set x2 {; append a x2; incr i} set a {} set i 1 while {$i<6} $x1$bb$x2 - set a -} {x1} -test while-1.12 {TclCompileWhileCmd: long command body} { + return $a +} -cleanup { + unset x1 bb x2 a i +} -result {x1} +test while-1.12 {TclCompileWhileCmd: long command body} -body { set a {} set i 1 while {$i<6} { @@ -132,22 +144,28 @@ test while-1.12 {TclCompileWhileCmd: long command body} { set a [concat $a $i] incr i } - set a -} {1 2 3} -test while-1.13 {TclCompileWhileCmd: while command result} { + return $a +} -cleanup { + unset a i +} -result {1 2 3} +test while-1.13 {TclCompileWhileCmd: while command result} -body { set i 0 set a [while {$i < 5} {incr i}] - set a -} {} -test while-1.14 {TclCompileWhileCmd: while command result} { + return $a +} -cleanup { + unset a i +} -result {} +test while-1.14 {TclCompileWhileCmd: while command result} -body { set i 0 set a [while {$i < 5} {if $i==3 break; incr i}] - set a -} {} + return $a +} -cleanup { + unset a i +} -result {} # Check "while" and "continue". -test while-2.1 {continue tests} { +test while-2.1 {continue tests} -body { set a {} set i 1 while {$i <= 4} { @@ -155,9 +173,11 @@ test while-2.1 {continue tests} { if {$i == 3} continue set a [concat $a $i] } - set a -} {2 4 5} -test while-2.2 {continue tests} { + return $a +} -cleanup { + unset a i +} -result {2 4 5} +test while-2.2 {continue tests} -body { set a {} set i 1 while {$i <= 4} { @@ -165,9 +185,11 @@ test while-2.2 {continue tests} { if {$i != 2} continue set a [concat $a $i] } - set a -} {2} -test while-2.3 {continue tests, nested loops} { + return $a +} -cleanup { + unset a i +} -result {2} +test while-2.3 {continue tests, nested loops} -body { set msg {} set i 1 while {$i <= 4} { @@ -179,9 +201,11 @@ test while-2.3 {continue tests, nested loops} { set msg [concat $msg "$i.$a"] } } - set msg -} {2.2 2.3 3.2 4.2 5.2} -test while-2.4 {continue tests, long command body} { + return $msg +} -cleanup { + unset a i msg +} -result {2.2 2.3 3.2 4.2 5.2} +test while-2.4 {continue tests, long command body} -body { set a {} set i 1 while {$i<6} { @@ -216,12 +240,14 @@ test while-2.4 {continue tests, long command body} { set a [concat $a $i] incr i } - set a -} {1 3} + return $a +} -cleanup { + unset a i +} -result {1 3} # Check "while" and "break". -test while-3.1 {break tests} { +test while-3.1 {break tests} -body { set a {} set i 1 while {$i <= 4} { @@ -229,9 +255,11 @@ test while-3.1 {break tests} { set a [concat $a $i] incr i } - set a -} {1 2} -test while-3.2 {break tests, nested loops} { + return $a +} -cleanup { + unset a i +} -result {1 2} +test while-3.2 {break tests, nested loops} -body { set msg {} set i 1 while {$i <= 4} { @@ -243,9 +271,11 @@ test while-3.2 {break tests, nested loops} { } incr i } - set msg -} {1.1 1.2 2.1 3.1 4.1} -test while-3.3 {break tests, long command body} { + return $msg +} -cleanup { + unset a i msg +} -result {1.1 1.2 2.1 3.1 4.1} +test while-3.3 {break tests, long command body} -body { set a {} set i 1 while {$i<6} { @@ -281,36 +311,42 @@ test while-3.3 {break tests, long command body} { set a [concat $a $i] incr i } - set a -} {1 3} + return $a +} -cleanup { + unset a i +} -result {1 3} # Check "while" with computed command names. -test while-4.1 {while and computed command names} { +test while-4.1 {while and computed command names} -body { set i 0 set z while $z {$i < 10} { incr i } - set i -} 10 -test while-4.2 {while (not compiled): missing test expression} { + return $i +} -cleanup { + unset i z +} -result 10 +test while-4.2 {while (not compiled): missing test expression} -body { set z while - catch {$z } msg - set msg -} {wrong # args: should be "while test command"} + $z +} -returnCodes error -cleanup { + unset z +} -result {wrong # args: should be "while test command"} test while-4.3 {while (not compiled): error in test expression} -body { set i 0 set z while - catch {$z {$i<} {set x 1}} msg - set ::errorInfo -} -match glob -result {*"$z {$i<} {set x 1}"} -test while-4.4 {while (not compiled): error in test expression} { + catch {$z {$i<} {set x 1}} + return $::errorInfo +} -match glob -cleanup { + unset i z +} -result {*"$z {$i<} {set x 1}"} +test while-4.4 {while (not compiled): error in test expression} -body { set z while - set err [catch {$z {"a"+"b"} {error "loop aborted"}} msg] - list $err $msg -} {1 {can't use non-numeric string as operand of "+"}} -test while-4.5 {while (not compiled): multiline test expr} { + $z {"a"+"b"} {error "loop aborted"} +} -returnCodes error -result {can't use non-numeric string as operand of "+"} +test while-4.5 {while (not compiled): multiline test expr} -body { set value 1 set z while $z {($tcl_platform(platform) != "foobar1") && \ @@ -318,9 +354,11 @@ test while-4.5 {while (not compiled): multiline test expr} { incr value break } - set value -} {2} -test while-4.6 {while (not compiled): non-numeric boolean test expr} { + return $value +} -cleanup { + unset value z +} -result {2} +test while-4.6 {while (not compiled): non-numeric boolean test expr} -body { set value 1 set z while $z {"true"} { @@ -329,31 +367,38 @@ test while-4.6 {while (not compiled): non-numeric boolean test expr} { break; } } - set value -} 6 -test while-4.7 {while (not compiled): test expr is enclosed in quotes} { + return $value +} -cleanup { + unset value z +} -result 6 +test while-4.7 {while (not compiled): test expr is enclosed in quotes} -body { set i 0 set z while $z "$i > 5" {} -} {} -test while-4.8 {while (not compiled): missing command body} { +} -cleanup { + unset i z +} -result {} +test while-4.8 {while (not compiled): missing command body} -body { set i 0 set z while - catch {$z {$i < 5} } msg - set msg -} {wrong # args: should be "while test command"} + $z {$i < 5} +} -returnCodes error -cleanup { + unset i z +} -result {wrong # args: should be "while test command"} test while-4.9 {while (not compiled): error compiling command body} -body { set i 0 set z while - catch {$z {$i < 5} {set}} msg + catch {$z {$i < 5} {set}} set ::errorInfo -} -match glob -result {wrong # args: should be "set varName ?newValue?" +} -match glob -cleanup { + unset i z +} -result {wrong # args: should be "set varName ?newValue?" while *ing "set" ("while" body line 1) invoked from within "$z {$i < 5} {set}"} -test while-4.10 {while (not compiled): simple command body} { +test while-4.10 {while (not compiled): simple command body} -body { set a {} set i 1 set z while @@ -362,29 +407,36 @@ test while-4.10 {while (not compiled): simple command body} { set a [concat $a $i] incr i } - set a -} {1 2 3} -test while-4.11 {while (not compiled): command body in quotes} { + return $a +} -cleanup { + unset a i z +} -result {1 2 3} +test while-4.11 {while (not compiled): command body in quotes} -body { set a {} set i 1 set z while $z {$i<6} "append a x; incr i" - set a -} {xxxxx} -test while-4.12 {while (not compiled): computed command body} { - set z while + return $a +} -cleanup { + unset a i z +} -result {xxxxx} +test while-4.12 {while (not compiled): computed command body} -setup { catch {unset x1} catch {unset bb} catch {unset x2} +} -body { + set z while set x1 {append a x1; } set bb {break} set x2 {; append a x2; incr i} set a {} set i 1 $z {$i<6} $x1$bb$x2 - set a -} {x1} -test while-4.13 {while (not compiled): long command body} { + return $a +} -cleanup { + unset z x1 bb x2 a i +} -result {x1} +test while-4.13 {while (not compiled): long command body} -body { set a {} set z while set i 1 @@ -419,33 +471,41 @@ test while-4.13 {while (not compiled): long command body} { set a [concat $a $i] incr i } - set a -} {1 2 3} -test while-4.14 {while (not compiled): while command result} { + return $a +} -cleanup { + unset a i z +} -result {1 2 3} +test while-4.14 {while (not compiled): while command result} -body { set i 0 set z while set a [$z {$i < 5} {incr i}] - set a -} {} -test while-4.15 {while (not compiled): while command result} { + return $a +} -cleanup { + unset a i z +} -result {} +test while-4.15 {while (not compiled): while command result} -body { set i 0 set z while set a [$z {$i < 5} {if $i==3 break; incr i}] - set a -} {} + return $a +} -cleanup { + unset a i z +} -result {} # Check "break" with computed command names. -test while-5.1 {break and computed command names} { +test while-5.1 {break and computed command names} -body { set i 0 set z break while 1 { if {$i > 10} $z incr i } - set i -} 11 -test while-5.2 {break tests with computed command names} { + return $i +} -cleanup { + unset i z +} -result 11 +test while-5.2 {break tests with computed command names} -body { set a {} set i 1 set z break @@ -454,9 +514,11 @@ test while-5.2 {break tests with computed command names} { set a [concat $a $i] incr i } - set a -} {1 2} -test while-5.3 {break tests, nested loops with computed command names} { + return $a +} -cleanup { + unset a i z +} -result {1 2} +test while-5.3 {break tests, nested loops with computed command names} -body { set msg {} set i 1 set z break @@ -469,9 +531,11 @@ test while-5.3 {break tests, nested loops with computed command names} { } incr i } - set msg -} {1.1 1.2 2.1 3.1 4.1} -test while-5.4 {break tests, long command body with computed command names} { + return $msg +} -cleanup { + unset a i z msg +} -result {1.1 1.2 2.1 3.1 4.1} +test while-5.4 {break tests, long command body with computed command names} -body { set a {} set i 1 set z break @@ -508,12 +572,14 @@ test while-5.4 {break tests, long command body with computed command names} { set a [concat $a $i] incr i } - set a -} {1 3} + return $a +} -cleanup { + unset a i z +} -result {1 3} # Check "continue" with computed command names. -test while-6.1 {continue and computed command names} { +test while-6.1 {continue and computed command names} -body { set i 0 set z continue while 1 { @@ -521,9 +587,11 @@ test while-6.1 {continue and computed command names} { if {$i < 10} $z break } - set i -} 10 -test while-6.2 {continue tests} { + return $i +} -cleanup { + unset i z +} -result 10 +test while-6.2 {continue tests} -body { set a {} set i 1 set z continue @@ -532,9 +600,11 @@ test while-6.2 {continue tests} { if {$i == 3} $z set a [concat $a $i] } - set a -} {2 4 5} -test while-6.3 {continue tests with computed command names} { + return $a +} -cleanup { + unset a i z +} -result {2 4 5} +test while-6.3 {continue tests with computed command names} -body { set a {} set i 1 set z continue @@ -543,9 +613,11 @@ test while-6.3 {continue tests with computed command names} { if {$i != 2} $z set a [concat $a $i] } - set a -} {2} -test while-6.4 {continue tests, nested loops with computed command names} { + return $a +} -cleanup { + unset a i z +} -result {2} +test while-6.4 {continue tests, nested loops with computed command names} -body { set msg {} set i 1 set z continue @@ -558,9 +630,11 @@ test while-6.4 {continue tests, nested loops with computed command names} { set msg [concat $msg "$i.$a"] } } - set msg -} {2.2 2.3 3.2 4.2 5.2} -test while-6.5 {continue tests, long command body with computed command names} { + return $msg +} -cleanup { + unset a i z msg +} -result {2.2 2.3 3.2 4.2 5.2} +test while-6.5 {continue tests, long command body with computed command names} -body { set a {} set i 1 set z continue @@ -596,12 +670,14 @@ test while-6.5 {continue tests, long command body with computed command names} { set a [concat $a $i] incr i } - set a -} {1 3} + return $a +} -cleanup { + unset a i z +} -result {1 3} # Test for incorrect "double evaluation" semantics -test while-7.1 {delayed substitution of body} { +test while-7.1 {delayed substitution of body} -body { set i 0 while {[incr i] < 10} " set result $i @@ -611,11 +687,18 @@ test while-7.1 {delayed substitution of body} { while {[incr i] < 10} " set result $i " - set result + return $result } append result [p] -} {00} +} -cleanup { + unset result i +} -result {00} # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: |