diff options
Diffstat (limited to 'tests/while.test')
| -rw-r--r-- | tests/while.test | 319 |
1 files changed, 319 insertions, 0 deletions
diff --git a/tests/while.test b/tests/while.test new file mode 100644 index 0000000..8642747 --- /dev/null +++ b/tests/while.test @@ -0,0 +1,319 @@ +# 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. +# +# Copyright (c) 1996 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) @(#) while.test 1.9 97/07/02 16:41:35 + +if {[string compare test [info procs test]] == 1} then {source defs} + +# Basic "while" operation. + +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.2 {TclCompileWhileCmd: error in test expression} { + set i 0 + catch {while {$i<}} msg + set errorInfo +} {syntax error in expression "$i<" + ("while" test expression) + while compiling +"while {$i<}"} +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} { + 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} { + set value 1 + while {"true"} { + incr value; + if {$value > 5} { + break; + } + } + set value +} 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} { + set i 0 + catch {while {$i < 5} } msg + set msg +} {wrong # args: should be "while test command"} +test while-1.8 {TclCompileWhileCmd: error compiling command body} { + set i 0 + catch {while {$i < 5} {set}} msg + set errorInfo +} {wrong # args: should be "set varName ?newValue?" + while compiling +"set" + ("while" body line 1) + while compiling +"while {$i < 5} {set}"} +test while-1.9 {TclCompileWhileCmd: simple command body} { + set a {} + set i 1 + while {$i<6} { + if $i==4 break + set a [concat $a $i] + incr i + } + set a +} {1 2 3} +test while-1.10 {TclCompileWhileCmd: command body in quotes} { + set a {} + set i 1 + while {$i<6} "append a x; incr i" + set a +} {xxxxx} +test while-1.11 {TclCompileWhileCmd: computed command body} { + catch {unset x1} + catch {unset bb} + catch {unset x2} + 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} { + set a {} + set i 1 + while {$i<6} { + if $i==4 break + if $i>5 continue + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + set a [concat $a $i] + incr i + } + set a +} {1 2 3} +test while-1.13 {TclCompileWhileCmd: while command result} { + set i 0 + set a [while {$i < 5} {incr i}] + set a +} {} +test while-1.14 {TclCompileWhileCmd: while command result} { + set i 0 + set a [while {$i < 5} {if $i==3 break; incr i}] + set a +} {} + +# Check "while" and "continue". + +test while-2.1 {continue tests} { + set a {} + set i 1 + while {$i <= 4} { + incr i + if {$i == 3} continue + set a [concat $a $i] + } + set a +} {2 4 5} +test while-2.2 {continue tests} { + set a {} + set i 1 + while {$i <= 4} { + incr i + if {$i != 2} continue + set a [concat $a $i] + } + set a +} {2} +test while-2.3 {continue tests, nested loops} { + set msg {} + set i 1 + while {$i <= 4} { + incr i + set a 1 + while {$a <= 2} { + incr a + if {$i>=3 && $a>=3} continue + 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} { + set a {} + set i 1 + while {$i<6} { + if $i==2 {incr i; continue} + if $i==4 break + if $i>5 continue + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + set a [concat $a $i] + incr i + } + set a +} {1 3} + +# Check "while" and "break". + +test while-3.1 {break tests} { + set a {} + set i 1 + while {$i <= 4} { + if {$i == 3} break + set a [concat $a $i] + incr i + } + set a +} {1 2} +test while-3.2 {break tests, nested loops} { + set msg {} + set i 1 + while {$i <= 4} { + set a 1 + while {$a <= 2} { + if {$i>=2 && $a>=2} break + set msg [concat $msg "$i.$a"] + incr a + } + incr i + } + set msg +} {1.1 1.2 2.1 3.1 4.1} +test while-3.3 {break tests, long command body} { + set a {} + set i 1 + while {$i<6} { + if $i==2 {incr i; continue} + if $i==5 break + if $i>5 continue + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if $i==4 break + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + if {$i>6 && $tcl_platform(machine)=="xxx"} { + catch {set a $a} msg + catch {incr i 5} msg + catch {incr i -5} msg + } + set a [concat $a $i] + incr i + } + set a +} {1 3} + +# Check "while", "break", "continue" and computed command names. + +test while-4.1 {while and computed command names} { + set i 0 + set z while + $z {$i < 10} { + incr i + } + set i +} 10 + +test while-5.1 {break and computed command names} { + set i 0 + set z break + while 1 { + if {$i > 10} $z + incr i + } + set i +} 11 + +test while-6.1 {continue and computed command names} { + set i 0 + set z continue + while 1 { + incr i + if {$i < 10} $z + break + } + set i +} 10 |