PageRenderTime 60ms CodeModel.GetById 32ms RepoModel.GetById 0ms app.codeStats 0ms

/brlcad/branches/dmtogl/src/other/tcl/tests/foreach.test

https://bitbucket.org/vrrm/brl-cad-copy-for-fast-history-browsing-in-git
Unknown | 275 lines | 259 code | 16 blank | 0 comment | 0 complexity | d23bf072768829c929d491612bd5ad58 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0, LGPL-2.1, Apache-2.0, AGPL-3.0, LGPL-3.0, GPL-3.0, MPL-2.0-no-copyleft-exception, CC-BY-SA-3.0, 0BSD, BSD-3-Clause
  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. # RCS: @(#) $Id$
  14. if {[lsearch [namespace children] ::tcltest] == -1} {
  15. package require tcltest
  16. namespace import -force ::tcltest::*
  17. }
  18. catch {unset a}
  19. catch {unset x}
  20. # Basic "foreach" operation.
  21. test foreach-1.1 {basic foreach tests} {
  22. set a {}
  23. foreach i {a b c d} {
  24. set a [concat $a $i]
  25. }
  26. set a
  27. } {a b c d}
  28. test foreach-1.2 {basic foreach tests} {
  29. set a {}
  30. foreach i {a b {{c d} e} {123 {{x}}}} {
  31. set a [concat $a $i]
  32. }
  33. set a
  34. } {a b {c d} e 123 {{x}}}
  35. test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1
  36. test foreach-1.4 {basic foreach tests} {
  37. catch {foreach} msg
  38. set msg
  39. } {wrong # args: should be "foreach varList list ?varList list ...? command"}
  40. test foreach-1.5 {basic foreach tests} {catch {foreach i} msg} 1
  41. test foreach-1.6 {basic foreach tests} {
  42. catch {foreach i} msg
  43. set msg
  44. } {wrong # args: should be "foreach varList list ?varList list ...? command"}
  45. test foreach-1.7 {basic foreach tests} {catch {foreach i j} msg} 1
  46. test foreach-1.8 {basic foreach tests} {
  47. catch {foreach i j} msg
  48. set msg
  49. } {wrong # args: should be "foreach varList list ?varList list ...? command"}
  50. test foreach-1.9 {basic foreach tests} {catch {foreach i j k l} msg} 1
  51. test foreach-1.10 {basic foreach tests} {
  52. catch {foreach i j k l} msg
  53. set msg
  54. } {wrong # args: should be "foreach varList list ?varList list ...? command"}
  55. test foreach-1.11 {basic foreach tests} {
  56. set a {}
  57. foreach i {} {
  58. set a [concat $a $i]
  59. }
  60. set a
  61. } {}
  62. test foreach-1.12 {foreach errors} {
  63. list [catch {foreach {{a}{b}} {1 2 3} {}} msg] $msg
  64. } {1 {list element in braces followed by "{b}" instead of space}}
  65. test foreach-1.13 {foreach errors} {
  66. list [catch {foreach a {{1 2}3} {}} msg] $msg
  67. } {1 {list element in braces followed by "3" instead of space}}
  68. catch {unset a}
  69. test foreach-1.14 {foreach errors} {
  70. catch {unset a}
  71. set a(0) 44
  72. list [catch {foreach a {1 2 3} {}} msg o] $msg $::errorInfo
  73. } {1 {can't set "a": variable is array} {can't set "a": variable is array
  74. (setting foreach loop variable "a")
  75. invoked from within
  76. "foreach a {1 2 3} {}"}}
  77. test foreach-1.15 {foreach errors} {
  78. list [catch {foreach {} {} {}} msg] $msg
  79. } {1 {foreach varlist is empty}}
  80. catch {unset a}
  81. test foreach-2.1 {parallel foreach tests} {
  82. set x {}
  83. foreach {a b} {1 2 3 4} {
  84. append x $b $a
  85. }
  86. set x
  87. } {2143}
  88. test foreach-2.2 {parallel foreach tests} {
  89. set x {}
  90. foreach {a b} {1 2 3 4 5} {
  91. append x $b $a
  92. }
  93. set x
  94. } {21435}
  95. test foreach-2.3 {parallel foreach tests} {
  96. set x {}
  97. foreach a {1 2 3} b {4 5 6} {
  98. append x $b $a
  99. }
  100. set x
  101. } {415263}
  102. test foreach-2.4 {parallel foreach tests} {
  103. set x {}
  104. foreach a {1 2 3} b {4 5 6 7 8} {
  105. append x $b $a
  106. }
  107. set x
  108. } {41526378}
  109. test foreach-2.5 {parallel foreach tests} {
  110. set x {}
  111. foreach {a b} {a b A B aa bb} c {c C cc CC} {
  112. append x $a $b $c
  113. }
  114. set x
  115. } {abcABCaabbccCC}
  116. test foreach-2.6 {parallel foreach tests} {
  117. set x {}
  118. foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
  119. append x $a $b $c $d $e
  120. }
  121. set x
  122. } {111112222233333}
  123. test foreach-2.7 {parallel foreach tests} {
  124. set x {}
  125. foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
  126. append x $a $b $c $d $e
  127. }
  128. set x
  129. } {1111 2222334}
  130. test foreach-2.8 {foreach only sets vars if repeating loop} {
  131. proc foo {} {
  132. set rgb {65535 0 0}
  133. foreach {r g b} [set rgb] {}
  134. return "r=$r, g=$g, b=$b"
  135. }
  136. foo
  137. } {r=65535, g=0, b=0}
  138. test foreach-2.9 {foreach only supports local scalar variables} {
  139. proc foo {} {
  140. set x {}
  141. foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]}
  142. set x
  143. }
  144. foo
  145. } {1 2 3 4}
  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. lsort [foo x]
  158. } [lsort {{0 zero} {1 one} {2 two} {3 three}}]
  159. test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
  160. catch {unset x}
  161. foreach {12.0} {a b c} {
  162. set x 12.0
  163. set x [expr $x + 1]
  164. }
  165. set x
  166. } 13.0
  167. # Check "continue".
  168. test foreach-5.1 {continue tests} {catch continue} 4
  169. test foreach-5.2 {continue tests} {
  170. set a {}
  171. foreach i {a b c d} {
  172. if {[string compare $i "b"] == 0} continue
  173. set a [concat $a $i]
  174. }
  175. set a
  176. } {a c d}
  177. test foreach-5.3 {continue tests} {
  178. set a {}
  179. foreach i {a b c d} {
  180. if {[string compare $i "b"] != 0} continue
  181. set a [concat $a $i]
  182. }
  183. set a
  184. } {b}
  185. test foreach-5.4 {continue tests} {catch {continue foo} msg} 1
  186. test foreach-5.5 {continue tests} {
  187. catch {continue foo} msg
  188. set msg
  189. } {wrong # args: should be "continue"}
  190. # Check "break".
  191. test foreach-6.1 {break tests} {catch break} 3
  192. test foreach-6.2 {break tests} {
  193. set a {}
  194. foreach i {a b c d} {
  195. if {[string compare $i "c"] == 0} break
  196. set a [concat $a $i]
  197. }
  198. set a
  199. } {a b}
  200. test foreach-6.3 {break tests} {catch {break foo} msg} 1
  201. test foreach-6.4 {break tests} {
  202. catch {break foo} msg
  203. set msg
  204. } {wrong # args: should be "break"}
  205. # Check for bug #406709
  206. test foreach-6.5 {break tests} {
  207. proc a {} {
  208. set a 1
  209. foreach b b {list [concat a; break]; incr a}
  210. incr a
  211. }
  212. a
  213. } {2}
  214. # Test for incorrect "double evaluation" semantics
  215. test foreach-7.1 {delayed substitution of body} {
  216. proc foo {} {
  217. set a 0
  218. foreach a [list 1 2 3] "
  219. set x $a
  220. "
  221. set x
  222. }
  223. foo
  224. } {0}
  225. # Test for [Bug 1189274]; crash on failure
  226. test foreach-8.1 {empty list handling} {
  227. proc crash {} {
  228. rename crash {}
  229. set a "x y z"
  230. set b ""
  231. foreach aa $a bb $b { set x "aa = $aa bb = $bb" }
  232. }
  233. crash
  234. } {}
  235. # [Bug 1671138]; infinite loop with empty var list in bytecompiled version
  236. test foreach-9.1 {compiled empty var list} {
  237. proc foo {} {
  238. foreach {} x {
  239. error "reached body"
  240. }
  241. }
  242. list [catch { foo } msg] $msg
  243. } {1 {foreach varlist is empty}}
  244. test foreach-10.1 {foreach: [Bug 1671087]} -setup {
  245. proc demo {} {
  246. set vals {1 2 3 4}
  247. trace add variable x write {string length $vals ;# }
  248. foreach {x y} $vals {format $y}
  249. }
  250. } -body {
  251. demo
  252. } -cleanup {
  253. rename demo {}
  254. } -result {}
  255. # cleanup
  256. catch {unset a}
  257. catch {unset x}
  258. ::tcltest::cleanupTests
  259. return