home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / foreach.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  5.6 KB  |  213 lines  |  [TEXT/ALFA]

  1. # Commands covered:  foreach, continue, break
  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. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # SCCS: @(#) foreach.test 1.8 97/08/12 18:19:27
  14.  
  15. if {[string compare test [info procs test]] == 1} then {source defs}
  16.  
  17. catch {unset a}
  18. catch {unset x}
  19.  
  20. # Basic "foreach" operation.
  21.  
  22. test foreach-1.1 {basic foreach tests} {
  23.     set a {}
  24.     foreach i {a b c d} {
  25.     set a [concat $a $i]
  26.     }
  27.     set a
  28. } {a b c d}
  29. test foreach-1.2 {basic foreach tests} {
  30.     set a {}
  31.     foreach i {a b {{c d} e} {123 {{x}}}} {
  32.     set a [concat $a $i]
  33.     }
  34.     set a
  35. } {a b {c d} e 123 {{x}}}
  36. test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1
  37. test foreach-1.4 {basic foreach tests} {
  38.     catch {foreach} msg
  39.     set msg
  40. } {wrong # args: should be "foreach varList list ?varList list ...? command"}
  41. test foreach-1.5 {basic foreach tests} {catch {foreach i} msg} 1
  42. test foreach-1.6 {basic foreach tests} {
  43.     catch {foreach i} msg
  44.     set msg
  45. } {wrong # args: should be "foreach varList list ?varList list ...? command"}
  46. test foreach-1.7 {basic foreach tests} {catch {foreach i j} msg} 1
  47. test foreach-1.8 {basic foreach tests} {
  48.     catch {foreach i j} msg
  49.     set msg
  50. } {wrong # args: should be "foreach varList list ?varList list ...? command"}
  51. test foreach-1.9 {basic foreach tests} {catch {foreach i j k l} msg} 1
  52. test foreach-1.10 {basic foreach tests} {
  53.     catch {foreach i j k l} msg
  54.     set msg
  55. } {wrong # args: should be "foreach varList list ?varList list ...? command"}
  56. test foreach-1.11 {basic foreach tests} {
  57.     set a {}
  58.     foreach i {} {
  59.     set a [concat $a $i]
  60.     }
  61.     set a
  62. } {}
  63. test foreach-1.12 {foreach errors} {
  64.     list [catch {foreach {{a}{b}} {1 2 3} {}} msg] $msg
  65. } {1 {list element in braces followed by "{b}" instead of space}}
  66. test foreach-1.13 {foreach errors} {
  67.     list [catch {foreach a {{1 2}3} {}} msg] $msg
  68. } {1 {list element in braces followed by "3" instead of space}}
  69. catch {unset a}
  70. test foreach-1.14 {foreach errors} {
  71.     catch {unset a}
  72.     set a(0) 44
  73.     list [catch {foreach a {1 2 3} {}} msg] $msg
  74. } {1 {couldn't set loop variable: "a"}}
  75. test foreach-1.15 {foreach errors} {
  76.     list [catch {foreach {} {} {}} msg] $msg
  77. } {1 {foreach varlist is empty}}
  78. catch {unset a}
  79.  
  80. test foreach-2.1 {parallel foreach tests} {
  81.     set x {}
  82.     foreach {a b} {1 2 3 4} {
  83.     append x $b $a
  84.     }
  85.     set x
  86. } {2143}
  87. test foreach-2.2 {parallel foreach tests} {
  88.     set x {}
  89.     foreach {a b} {1 2 3 4 5} {
  90.     append x $b $a
  91.     }
  92.     set x
  93. } {21435}
  94. test foreach-2.3 {parallel foreach tests} {
  95.     set x {}
  96.     foreach a {1 2 3} b {4 5 6} {
  97.     append x $b $a
  98.     }
  99.     set x
  100. } {415263}
  101. test foreach-2.4 {parallel foreach tests} {
  102.     set x {}
  103.     foreach a {1 2 3} b {4 5 6 7 8} {
  104.     append x $b $a
  105.     }
  106.     set x
  107. } {41526378}
  108. test foreach-2.5 {parallel foreach tests} {
  109.     set x {}
  110.     foreach {a b} {a b A B aa bb} c {c C cc CC} {
  111.     append x $a $b $c
  112.     }
  113.     set x
  114. } {abcABCaabbccCC}
  115. test foreach-2.6 {parallel foreach tests} {
  116.     set x {}
  117.     foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
  118.     append x $a $b $c $d $e
  119.     }
  120.     set x
  121. } {111112222233333}
  122. test foreach-2.7 {parallel foreach tests} {
  123.     set x {}
  124.     foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
  125.     append x $a $b $c $d $e
  126.     }
  127.     set x
  128. } {1111 2222334}
  129. test foreach-2.8 {foreach only sets vars if repeating loop} {
  130.     proc foo {} {
  131.         set rgb {65535 0 0}
  132.         foreach {r g b} [set rgb] {}
  133.         return "r=$r, g=$g, b=$b"
  134.     }
  135.     foo
  136. } {r=65535, g=0, b=0}
  137. test foreach-2.9 {foreach only supports local scalar variables} {
  138.     proc foo {} {
  139.         set x {}
  140.         foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]}
  141.         set x
  142.     }
  143.     foo
  144. } {1 2 3 4}
  145.  
  146. test foreach-3.1 {compiled foreach backward jump works correctly} {
  147.     catch {unset x}
  148.     proc foo {arrayName} {
  149.         upvar 1 $arrayName a
  150.         set l {}
  151.         foreach member [array names a] {
  152.             lappend l [list $member [set a($member)]]
  153.         }
  154.         return $l
  155.     }
  156.     array set x {0 zero 1 one 2 two 3 three}
  157.     foo x
  158. } {{0 zero} {1 one} {2 two} {3 three}}
  159.  
  160. test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
  161.     catch {unset x}
  162.     foreach {12.0} {a b c} {
  163.         set x 12.0  
  164.         set x [expr $x + 1]
  165.     }
  166.     set x
  167. } 13.0
  168.  
  169. # Check "continue".
  170.  
  171. test foreach-4.1 {continue tests} {catch continue} 4
  172. test foreach-4.2 {continue tests} {
  173.     set a {}
  174.     foreach i {a b c d} {
  175.     if {[string compare $i "b"] == 0} continue
  176.     set a [concat $a $i]
  177.     }
  178.     set a
  179. } {a c d}
  180. test foreach-4.3 {continue tests} {
  181.     set a {}
  182.     foreach i {a b c d} {
  183.     if {[string compare $i "b"] != 0} continue
  184.     set a [concat $a $i]
  185.     }
  186.     set a
  187. } {b}
  188. test foreach-4.4 {continue tests} {catch {continue foo} msg} 1
  189. test foreach-4.5 {continue tests} {
  190.     catch {continue foo} msg
  191.     set msg
  192. } {wrong # args: should be "continue"}
  193.  
  194. # Check "break".
  195.  
  196. test foreach-5.1 {break tests} {catch break} 3
  197. test foreach-5.2 {break tests} {
  198.     set a {}
  199.     foreach i {a b c d} {
  200.     if {[string compare $i "c"] == 0} break
  201.     set a [concat $a $i]
  202.     }
  203.     set a
  204. } {a b}
  205. test foreach-5.3 {break tests} {catch {break foo} msg} 1
  206. test foreach-5.4 {break tests} {
  207.     catch {break foo} msg
  208.     set msg
  209. } {wrong # args: should be "break"}
  210.  
  211. catch {unset a}
  212. catch {unset x}
  213.