os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/while-old.test
author sl@SLION-WIN7.fritz.box
Fri, 15 Jun 2012 03:10:57 +0200
changeset 0 bde4ae8d615e
permissions -rw-r--r--
First public contribution.
sl@0
     1
# Commands covered:  while
sl@0
     2
#
sl@0
     3
# This file contains the original set of tests for Tcl's while command.
sl@0
     4
# Since the while command is now compiled, a new set of tests covering
sl@0
     5
# the new implementation is in the file "while.test". Sourcing this file
sl@0
     6
# into Tcl runs the tests and generates output for errors.
sl@0
     7
# No output means no errors were found.
sl@0
     8
#
sl@0
     9
# Copyright (c) 1991-1993 The Regents of the University of California.
sl@0
    10
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
sl@0
    11
# Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0
    12
#
sl@0
    13
# See the file "license.terms" for information on usage and redistribution
sl@0
    14
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0
    15
#
sl@0
    16
# RCS: @(#) $Id: while-old.test,v 1.6 2000/04/10 17:19:06 ericm Exp $
sl@0
    17
sl@0
    18
if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0
    19
    package require tcltest
sl@0
    20
    namespace import -force ::tcltest::*
sl@0
    21
}
sl@0
    22
sl@0
    23
test while-old-1.1 {basic while loops} {
sl@0
    24
    set count 0
sl@0
    25
    while {$count < 10} {set count [expr $count+1]}
sl@0
    26
    set count
sl@0
    27
} 10
sl@0
    28
test while-old-1.2 {basic while loops} {
sl@0
    29
    set value xxx
sl@0
    30
    while {2 > 3} {set value yyy}
sl@0
    31
    set value
sl@0
    32
} xxx
sl@0
    33
test while-old-1.3 {basic while loops} {
sl@0
    34
    set value 1
sl@0
    35
    while {"true"} {
sl@0
    36
	incr value;
sl@0
    37
	if {$value > 5} {
sl@0
    38
	    break;
sl@0
    39
	}
sl@0
    40
    }
sl@0
    41
    set value
sl@0
    42
} 6
sl@0
    43
test while-old-1.4 {basic while loops, multiline test expr} {
sl@0
    44
    set value 1
sl@0
    45
    while {($tcl_platform(platform) != "foobar1") && \
sl@0
    46
	    ($tcl_platform(platform) != "foobar2")} {
sl@0
    47
        incr value
sl@0
    48
        break
sl@0
    49
    }
sl@0
    50
    set value
sl@0
    51
} {2}
sl@0
    52
test while-old-1.5 {basic while loops, test expr in quotes} {
sl@0
    53
    set value 1
sl@0
    54
    while "0 < 3" {set value 2; break}
sl@0
    55
    set value
sl@0
    56
} {2}
sl@0
    57
sl@0
    58
test while-old-2.1 {continue in while loop} {
sl@0
    59
    set list {1 2 3 4 5}
sl@0
    60
    set index 0
sl@0
    61
    set result {}
sl@0
    62
    while {$index < 5} {
sl@0
    63
	if {$index == 2} {set index [expr $index+1]; continue}
sl@0
    64
	set result [concat $result [lindex $list $index]]
sl@0
    65
	set index [expr $index+1]
sl@0
    66
    }
sl@0
    67
    set result
sl@0
    68
} {1 2 4 5}
sl@0
    69
sl@0
    70
test while-old-3.1 {break in while loop} {
sl@0
    71
    set list {1 2 3 4 5}
sl@0
    72
    set index 0
sl@0
    73
    set result {}
sl@0
    74
    while {$index < 5} {
sl@0
    75
	if {$index == 3} break
sl@0
    76
	set result [concat $result [lindex $list $index]]
sl@0
    77
	set index [expr $index+1]
sl@0
    78
    }
sl@0
    79
    set result
sl@0
    80
} {1 2 3}
sl@0
    81
sl@0
    82
test while-old-4.1 {errors in while loops} {
sl@0
    83
    set err [catch {while} msg]
sl@0
    84
    list $err $msg
sl@0
    85
} {1 {wrong # args: should be "while test command"}}
sl@0
    86
test while-old-4.2 {errors in while loops} {
sl@0
    87
    set err [catch {while 1} msg]
sl@0
    88
    list $err $msg
sl@0
    89
} {1 {wrong # args: should be "while test command"}}
sl@0
    90
test while-old-4.3 {errors in while loops} {
sl@0
    91
    set err [catch {while 1 2 3} msg]
sl@0
    92
    list $err $msg
sl@0
    93
} {1 {wrong # args: should be "while test command"}}
sl@0
    94
test while-old-4.4 {errors in while loops} {
sl@0
    95
    set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
sl@0
    96
    list $err $msg
sl@0
    97
} {1 {can't use non-numeric string as operand of "+"}}
sl@0
    98
test while-old-4.5 {errors in while loops} {
sl@0
    99
    catch {unset x}
sl@0
   100
    set x 1
sl@0
   101
    set err [catch {while {$x} {set x foo}} msg]
sl@0
   102
    list $err $msg
sl@0
   103
} {1 {expected boolean value but got "foo"}}
sl@0
   104
test while-old-4.6 {errors in while loops} {
sl@0
   105
    set err [catch {while {1} {error "loop aborted"}} msg]
sl@0
   106
    list $err $msg $errorInfo
sl@0
   107
} {1 {loop aborted} {loop aborted
sl@0
   108
    while executing
sl@0
   109
"error "loop aborted""}}
sl@0
   110
sl@0
   111
test while-old-5.1 {while return result} {
sl@0
   112
    while {0} {set a 400}
sl@0
   113
} {}
sl@0
   114
test while-old-5.2 {while return result} {
sl@0
   115
    set x 1
sl@0
   116
    while {$x} {set x 0}
sl@0
   117
} {}
sl@0
   118
sl@0
   119
# cleanup
sl@0
   120
::tcltest::cleanupTests
sl@0
   121
return
sl@0
   122
sl@0
   123
sl@0
   124
sl@0
   125
sl@0
   126
sl@0
   127
sl@0
   128
sl@0
   129
sl@0
   130
sl@0
   131
sl@0
   132
sl@0
   133