os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/while-old.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/while-old.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,133 @@
1.4 +# Commands covered: while
1.5 +#
1.6 +# This file contains the original set of tests for Tcl's while command.
1.7 +# Since the while command is now compiled, a new set of tests covering
1.8 +# the new implementation is in the file "while.test". Sourcing this file
1.9 +# into Tcl runs the tests and generates output for errors.
1.10 +# No output means no errors were found.
1.11 +#
1.12 +# Copyright (c) 1991-1993 The Regents of the University of California.
1.13 +# Copyright (c) 1994-1996 Sun Microsystems, Inc.
1.14 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.15 +#
1.16 +# See the file "license.terms" for information on usage and redistribution
1.17 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.18 +#
1.19 +# RCS: @(#) $Id: while-old.test,v 1.6 2000/04/10 17:19:06 ericm Exp $
1.20 +
1.21 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.22 + package require tcltest
1.23 + namespace import -force ::tcltest::*
1.24 +}
1.25 +
1.26 +test while-old-1.1 {basic while loops} {
1.27 + set count 0
1.28 + while {$count < 10} {set count [expr $count+1]}
1.29 + set count
1.30 +} 10
1.31 +test while-old-1.2 {basic while loops} {
1.32 + set value xxx
1.33 + while {2 > 3} {set value yyy}
1.34 + set value
1.35 +} xxx
1.36 +test while-old-1.3 {basic while loops} {
1.37 + set value 1
1.38 + while {"true"} {
1.39 + incr value;
1.40 + if {$value > 5} {
1.41 + break;
1.42 + }
1.43 + }
1.44 + set value
1.45 +} 6
1.46 +test while-old-1.4 {basic while loops, multiline test expr} {
1.47 + set value 1
1.48 + while {($tcl_platform(platform) != "foobar1") && \
1.49 + ($tcl_platform(platform) != "foobar2")} {
1.50 + incr value
1.51 + break
1.52 + }
1.53 + set value
1.54 +} {2}
1.55 +test while-old-1.5 {basic while loops, test expr in quotes} {
1.56 + set value 1
1.57 + while "0 < 3" {set value 2; break}
1.58 + set value
1.59 +} {2}
1.60 +
1.61 +test while-old-2.1 {continue in while loop} {
1.62 + set list {1 2 3 4 5}
1.63 + set index 0
1.64 + set result {}
1.65 + while {$index < 5} {
1.66 + if {$index == 2} {set index [expr $index+1]; continue}
1.67 + set result [concat $result [lindex $list $index]]
1.68 + set index [expr $index+1]
1.69 + }
1.70 + set result
1.71 +} {1 2 4 5}
1.72 +
1.73 +test while-old-3.1 {break in while loop} {
1.74 + set list {1 2 3 4 5}
1.75 + set index 0
1.76 + set result {}
1.77 + while {$index < 5} {
1.78 + if {$index == 3} break
1.79 + set result [concat $result [lindex $list $index]]
1.80 + set index [expr $index+1]
1.81 + }
1.82 + set result
1.83 +} {1 2 3}
1.84 +
1.85 +test while-old-4.1 {errors in while loops} {
1.86 + set err [catch {while} msg]
1.87 + list $err $msg
1.88 +} {1 {wrong # args: should be "while test command"}}
1.89 +test while-old-4.2 {errors in while loops} {
1.90 + set err [catch {while 1} msg]
1.91 + list $err $msg
1.92 +} {1 {wrong # args: should be "while test command"}}
1.93 +test while-old-4.3 {errors in while loops} {
1.94 + set err [catch {while 1 2 3} msg]
1.95 + list $err $msg
1.96 +} {1 {wrong # args: should be "while test command"}}
1.97 +test while-old-4.4 {errors in while loops} {
1.98 + set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
1.99 + list $err $msg
1.100 +} {1 {can't use non-numeric string as operand of "+"}}
1.101 +test while-old-4.5 {errors in while loops} {
1.102 + catch {unset x}
1.103 + set x 1
1.104 + set err [catch {while {$x} {set x foo}} msg]
1.105 + list $err $msg
1.106 +} {1 {expected boolean value but got "foo"}}
1.107 +test while-old-4.6 {errors in while loops} {
1.108 + set err [catch {while {1} {error "loop aborted"}} msg]
1.109 + list $err $msg $errorInfo
1.110 +} {1 {loop aborted} {loop aborted
1.111 + while executing
1.112 +"error "loop aborted""}}
1.113 +
1.114 +test while-old-5.1 {while return result} {
1.115 + while {0} {set a 400}
1.116 +} {}
1.117 +test while-old-5.2 {while return result} {
1.118 + set x 1
1.119 + while {$x} {set x 0}
1.120 +} {}
1.121 +
1.122 +# cleanup
1.123 +::tcltest::cleanupTests
1.124 +return
1.125 +
1.126 +
1.127 +
1.128 +
1.129 +
1.130 +
1.131 +
1.132 +
1.133 +
1.134 +
1.135 +
1.136 +