summaryrefslogtreecommitdiffstats
path: root/tcl8.6/tests/while.test
diff options
context:
space:
mode:
Diffstat (limited to 'tcl8.6/tests/while.test')
-rw-r--r--tcl8.6/tests/while.test702
1 files changed, 702 insertions, 0 deletions
diff --git a/tcl8.6/tests/while.test b/tcl8.6/tests/while.test
new file mode 100644
index 0000000..642ec93
--- /dev/null
+++ b/tcl8.6/tests/while.test
@@ -0,0 +1,702 @@
+# 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.
+# 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.
+
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2
+ namespace import -force ::tcltest::*
+}
+
+# Basic "while" operation.
+
+catch {unset i}
+catch {unset a}
+
+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}
+ return $::errorInfo
+} -cleanup {
+ unset i
+} -match glob -result {*"while {$i<} break"}
+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
+ }
+ 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;
+ if {$value > 5} {
+ break;
+ }
+ }
+ 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} -body {
+ set i 0
+ 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}}
+ 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} -body {
+ set a {}
+ set i 1
+ while {$i<6} {
+ if $i==4 break
+ set a [concat $a $i]
+ incr i
+ }
+ 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"
+ 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
+ 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} {
+ 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
+ }
+ 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}]
+ 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}]
+ return $a
+} -cleanup {
+ unset a i
+} -result {}
+
+# Check "while" and "continue".
+
+test while-2.1 {continue tests} -body {
+ set a {}
+ set i 1
+ while {$i <= 4} {
+ incr i
+ if {$i == 3} continue
+ set a [concat $a $i]
+ }
+ 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} {
+ incr i
+ if {$i != 2} continue
+ set a [concat $a $i]
+ }
+ 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} {
+ incr i
+ set a 1
+ while {$a <= 2} {
+ incr a
+ if {$i>=3 && $a>=3} continue
+ set msg [concat $msg "$i.$a"]
+ }
+ }
+ 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} {
+ 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
+ }
+ return $a
+} -cleanup {
+ unset a i
+} -result {1 3}
+
+# Check "while" and "break".
+
+test while-3.1 {break tests} -body {
+ set a {}
+ set i 1
+ while {$i <= 4} {
+ if {$i == 3} break
+ set a [concat $a $i]
+ incr i
+ }
+ 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} {
+ set a 1
+ while {$a <= 2} {
+ if {$i>=2 && $a>=2} break
+ set msg [concat $msg "$i.$a"]
+ incr a
+ }
+ incr i
+ }
+ 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} {
+ 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
+ }
+ return $a
+} -cleanup {
+ unset a i
+} -result {1 3}
+
+# Check "while" with computed command names.
+
+test while-4.1 {while and computed command names} -body {
+ set i 0
+ set z while
+ $z {$i < 10} {
+ incr i
+ }
+ return $i
+} -cleanup {
+ unset i z
+} -result 10
+test while-4.2 {while (not compiled): missing test expression} -body {
+ set z while
+ $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}}
+ 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
+ $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") && \
+ ($tcl_platform(platform) != "foobar2")} {
+ incr value
+ break
+ }
+ 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"} {
+ incr value;
+ if {$value > 5} {
+ break;
+ }
+ }
+ 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" {}
+} -cleanup {
+ unset i z
+} -result {}
+test while-4.8 {while (not compiled): missing command body} -body {
+ set i 0
+ set z while
+ $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}}
+ set ::errorInfo
+} -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} -body {
+ set a {}
+ set i 1
+ set z while
+ $z {$i<6} {
+ if $i==4 break
+ set a [concat $a $i]
+ incr i
+ }
+ 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"
+ 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
+ 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
+ $z {$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
+ }
+ 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}]
+ 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}]
+ return $a
+} -cleanup {
+ unset a i z
+} -result {}
+
+# Check "break" with 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
+ }
+ 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
+ while {$i <= 4} {
+ if {$i == 3} $z
+ set a [concat $a $i]
+ incr i
+ }
+ 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
+ while {$i <= 4} {
+ set a 1
+ while {$a <= 2} {
+ if {$i>=2 && $a>=2} $z
+ set msg [concat $msg "$i.$a"]
+ incr a
+ }
+ incr i
+ }
+ 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
+ while {$i<6} {
+ if $i==2 {incr i; continue}
+ if $i==5 $z
+ 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 $z
+ 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
+ }
+ 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} -body {
+ set i 0
+ set z continue
+ while 1 {
+ incr i
+ if {$i < 10} $z
+ break
+ }
+ return $i
+} -cleanup {
+ unset i z
+} -result 10
+test while-6.2 {continue tests} -body {
+ set a {}
+ set i 1
+ set z continue
+ while {$i <= 4} {
+ incr i
+ if {$i == 3} $z
+ set a [concat $a $i]
+ }
+ 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
+ while {$i <= 4} {
+ incr i
+ if {$i != 2} $z
+ set a [concat $a $i]
+ }
+ 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
+ while {$i <= 4} {
+ incr i
+ set a 1
+ while {$a <= 2} {
+ incr a
+ if {$i>=3 && $a>=3} $z
+ set msg [concat $msg "$i.$a"]
+ }
+ }
+ 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
+ while {$i<6} {
+ if $i==2 {incr i; continue}
+ if $i==4 break
+ if $i>5 $z
+ 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
+ }
+ return $a
+} -cleanup {
+ unset a i z
+} -result {1 3}
+
+# Test for incorrect "double evaluation" semantics
+
+test while-7.1 {delayed substitution of body} -body {
+ set i 0
+ while {[incr i] < 10} "
+ set result $i
+ "
+ proc p {} {
+ set i 0
+ while {[incr i] < 10} "
+ set result $i
+ "
+ return $result
+ }
+ append result [p]
+} -cleanup {
+ unset result i
+} -result {00}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End: