home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tcl7.0b1 / tests / while.test < prev    next >
Encoding:
Text File  |  1993-04-21  |  3.6 KB  |  114 lines
  1. # Commands covered:  while
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1991-1993 The Regents of the University of California.
  8. # All rights reserved.
  9. #
  10. # Permission is hereby granted, without written agreement and without
  11. # license or royalty fees, to use, copy, modify, and distribute this
  12. # software and its documentation for any purpose, provided that the
  13. # above copyright notice and the following two paragraphs appear in
  14. # all copies of this software.
  15. #
  16. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20. #
  21. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26. #
  27. # $Header: /user6/ouster/tcl/tests/RCS/while.test,v 1.7 93/04/21 11:18:58 ouster Exp $ (Berkeley)
  28.  
  29. if {[string compare test [info procs test]] == 1} then {source defs}
  30.  
  31. test while-1.1 {basic while loops} {
  32.     set count 0
  33.     while {$count < 10} {set count [expr $count+1]}
  34.     set count
  35. } 10
  36. test while-1.2 {basic while loops} {
  37.     set value xxx
  38.     while {2 > 3} {set value yyy}
  39.     set value
  40. } xxx
  41. test while-1.3 {basic while loops} {
  42.     set value 1
  43.     while {"true"} {
  44.     incr value;
  45.     if {$value > 5} {
  46.         break;
  47.     }
  48.     }
  49.     set value
  50. } 6
  51.  
  52. test while-2.1 {continue in while loop} {
  53.     set list {1 2 3 4 5}
  54.     set index 0
  55.     set result {}
  56.     while {$index < 5} {
  57.     if {$index == 2} {set index [expr $index+1]; continue}
  58.     set result [concat $result [lindex $list $index]]
  59.     set index [expr $index+1]
  60.     }
  61.     set result
  62. } {1 2 4 5}
  63.  
  64. test while-3.1 {break in while loop} {
  65.     set list {1 2 3 4 5}
  66.     set index 0
  67.     set result {}
  68.     while {$index < 5} {
  69.     if {$index == 3} break
  70.     set result [concat $result [lindex $list $index]]
  71.     set index [expr $index+1]
  72.     }
  73.     set result
  74. } {1 2 3}
  75.  
  76. test while-4.1 {errors in while loops} {
  77.     set err [catch {while} msg]
  78.     list $err $msg
  79. } {1 {wrong # args: should be "while test command"}}
  80. test while-4.2 {errors in while loops} {
  81.     set err [catch {while 1} msg]
  82.     list $err $msg
  83. } {1 {wrong # args: should be "while test command"}}
  84. test while-4.3 {errors in while loops} {
  85.     set err [catch {while 1 2 3} msg]
  86.     list $err $msg
  87. } {1 {wrong # args: should be "while test command"}}
  88. test while-4.4 {errors in while loops} {
  89.     set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
  90.     list $err $msg
  91. } {1 {can't use non-numeric string as operand of "+"}}
  92. test while-4.5 {errors in while loops} {
  93.     set x 1
  94.     set err [catch {while {$x} {set x foo}} msg]
  95.     list $err $msg
  96. } {1 {expected boolean value but got "foo"}}
  97. test while-4.6 {errors in while loops} {
  98.     set err [catch {while {1} {error "loop aborted"}} msg]
  99.     list $err $msg $errorInfo
  100. } {1 {loop aborted} {loop aborted
  101.     while executing
  102. "error "loop aborted""
  103.     ("while" body line 1)
  104.     invoked from within
  105. "while {1} {error "loop aborted"}"}}
  106.  
  107. test while-5.1 {while return result} {
  108.     while {0} {set a 400}
  109. } {}
  110. test while-5.2 {while return result} {
  111.     set x 1
  112.     while {$x} {set x 0}
  113. } {}
  114.