diff options
author | Steve Bennett <steveb@workware.net.au> | 2010-01-24 11:49:28 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2010-10-15 11:02:42 +1000 |
commit | b367df9ca11f36a392b97afc2767694f8bfe1c4f (patch) | |
tree | b61a231c02622789cadaee3f3ed7c824d2a221d1 /tests/while.test | |
parent | fb44f9ee2d4b23bc4f5f46ad3b01b33e563932cd (diff) | |
download | jimtcl-b367df9ca11f36a392b97afc2767694f8bfe1c4f.zip jimtcl-b367df9ca11f36a392b97afc2767694f8bfe1c4f.tar.gz jimtcl-b367df9ca11f36a392b97afc2767694f8bfe1c4f.tar.bz2 |
Bugs, features, tests
Subst was broken for backslash escapes
Add support for return, break, continue in subst commands
Accept abbreviations for switches to subst
Fix 'list #'
More tests
Diffstat (limited to 'tests/while.test')
-rw-r--r-- | tests/while.test | 127 |
1 files changed, 127 insertions, 0 deletions
diff --git a/tests/while.test b/tests/while.test new file mode 100644 index 0000000..5368b3e --- /dev/null +++ b/tests/while.test @@ -0,0 +1,127 @@ +# Commands covered: while +# +# This file contains the original set of tests for Tcl's while command. +# Since the while command is now compiled, a new set of tests covering +# the new implementation is in the file "while.test". Sourcing this file +# into Tcl runs the tests and generates output for errors. +# No output means no errors were found. +# +# Copyright (c) 1991-1993 The Regents of the University of California. +# Copyright (c) 1994-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. +# +# RCS: @(#) $Id: while-old.test,v 1.6 2000/04/10 17:19:06 ericm Exp $ + +source testing.tcl + +test while-old-1.1 {basic while loops} { + set count 0 + while {$count < 10} {set count [expr $count+1]} + set count +} 10 +test while-old-1.2 {basic while loops} { + set value xxx + while {2 > 3} {set value yyy} + set value +} xxx +test while-old-1.3 {basic while loops} { + set value 1 + while {1} { + incr value; + if {$value > 5} { + break; + } + } + set value +} 6 +test while-old-1.4 {basic while loops, multiline test expr} { + set value 1 + while {($tcl_platform(platform) != "foobar1") && \ + ($tcl_platform(platform) != "foobar2")} { + incr value + break + } + set value +} {2} +test while-old-1.5 {basic while loops, test expr in quotes} { + set value 1 + while "0 < 3" {set value 2; break} + set value +} {2} + +test while-old-2.1 {continue in while loop} { + set list {1 2 3 4 5} + set index 0 + set result {} + while {$index < 5} { + if {$index == 2} {set index [expr $index+1]; continue} + set result [concat $result [lindex $list $index]] + set index [expr $index+1] + } + set result +} {1 2 4 5} + +test while-old-3.1 {break in while loop} { + set list {1 2 3 4 5} + set index 0 + set result {} + while {$index < 5} { + if {$index == 3} break + set result [concat $result [lindex $list $index]] + set index [expr $index+1] + } + set result +} {1 2 3} + +test while-old-4.1 {errors in while loops} { + set err [catch {while} msg] + list $err +} {1} +test while-old-4.2 {errors in while loops} { + set err [catch {while 1} msg] + list $err +} {1} +test while-old-4.3 {errors in while loops} { + set err [catch {while 1 2 3} msg] + list $err +} {1} +test while-old-4.4 {errors in while loops} { + set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] + list $err +} {1} +test while-old-4.5 {errors in while loops} { + catch {unset x} + set x 1 + set err [catch {while {$x} {set x foo}} msg] + list $err +} {1} +test while-old-4.6 {errors in while loops} { + set err [catch {while {1} {error "loop aborted"}} msg] + list $err $msg +} {1 {loop aborted}} + +test while-old-5.1 {while return result} { + while {0} {set a 400} +} {} +test while-old-5.2 {while return result} { + set x 1 + while {$x} {set x 0} +} {} + +# cleanup +testreport + + + + + + + + + + + + |