util/src/TclTk/tcl8.6.12/tests/while-old.test

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