tests/while.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 # RCS: @(#) $Id: while-old.test,v 1.6 2000/04/10 17:19:06 ericm Exp $
  17
  18 source [file dirname [info script]]/testing.tcl
  19
  20 test while-old-1.1 {basic while loops} {
  21     set count 0
  22     while {$count < 10} {set count [expr $count+1]}
  23     set count
  24 } 10
  25 test while-old-1.2 {basic while loops} {
  26     set value xxx
  27     while {2 > 3} {set value yyy}
  28     set value
  29 } xxx
  30 test while-old-1.3 {basic while loops} {
  31     set value 1
  32     while {1} {
  33         incr value;
  34         if {$value > 5} {
  35             break;
  36         }
  37     }
  38     set value
  39 } 6
  40 test while-old-1.4 {basic while loops, multiline test expr} {
  41     set value 1
  42     while {($tcl_platform(platform) != "foobar1") && \
  43             ($tcl_platform(platform) != "foobar2")} {
  44         incr value
  45         break
  46     }
  47     set value
  48 } {2}
  49 test while-old-1.5 {basic while loops, test expr in quotes} {
  50     set value 1
  51     while "0 < 3" {set value 2; break}
  52     set value
  53 } {2}
  54
  55 test while-old-2.1 {continue in while loop} {
  56     set list {1 2 3 4 5}
  57     set index 0
  58     set result {}
  59     while {$index < 5} {
  60         if {$index == 2} {set index [expr $index+1]; continue}
  61         set result [concat $result [lindex $list $index]]
  62         set index [expr $index+1]
  63     }
  64     set result
  65 } {1 2 4 5}
  66
  67 test while-old-3.1 {break in while loop} {
  68     set list {1 2 3 4 5}
  69     set index 0
  70     set result {}
  71     while {$index < 5} {
  72         if {$index == 3} break
  73         set result [concat $result [lindex $list $index]]
  74         set index [expr $index+1]
  75     }
  76     set result
  77 } {1 2 3}
  78
  79 test while-old-4.1 {errors in while loops} {
  80     set err [catch {while} msg]
  81     list $err
  82 } {1}
  83 test while-old-4.2 {errors in while loops} {
  84     set err [catch {while 1} msg]
  85     list $err
  86 } {1}
  87 test while-old-4.3 {errors in while loops} {
  88     set err [catch {while 1 2 3} msg]
  89     list $err
  90 } {1}
  91 test while-old-4.4 {errors in while loops} {
  92     set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
  93     list $err
  94 } {1}
  95 test while-old-4.5 {errors in while loops} {
  96     catch {unset x}
  97     set x 1
  98     set err [catch {while {$x} {set x foo}} msg]
  99     list $err
 100 } {1}
 101 test while-old-4.6 {errors in while loops} {
 102     set err [catch {while {1} {error "loop aborted"}} msg]
 103     list $err $msg
 104 } {1 {loop aborted}}
 105
 106 test while-old-5.1 {while return result} {
 107     while {0} {set a 400}
 108 } {}
 109 test while-old-5.2 {while return result} {
 110     set x 1
 111     while {$x} {set x 0}
 112 } {}
 113 test while-old-5.3 {while return result} {
 114     set x true
 115     while {$x} {set x 0}
 116 } {}
 117
 118 # cleanup
 119 testreport
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131