Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 297 lines (243 sloc) 6.037 kB
d6ead2c Initial commit from r31638 of https://svn.perl.org/parrot/trunk/langu…
wcoleda authored
1 #!perl
2
06994a0 Update the files in the repo to add the Parrot Foundation as copyrigh…
arbelo authored
3 # Copyright (C) 2004-2008, The Parrot Foundation.
d6ead2c Initial commit from r31638 of https://svn.perl.org/parrot/trunk/langu…
wcoleda authored
4
5 # the following lines re-execute this as a tcl script
6 # the \ at the end of these lines makes them a comment in tcl \
c34bff7 Tests only need to run from top level build dir.
wcoleda authored
7 use lib qw(lib); # \
d6ead2c Initial commit from r31638 of https://svn.perl.org/parrot/trunk/langu…
wcoleda authored
8 use Tcl::Test; #\
9 __DATA__
10
11 source lib/test_more.tcl
12 plan 50
13
14 eval_is {array}\
15 {wrong # args: should be "array option arrayName ?arg ...?"}\
16 {array, no args}
17
18 eval_is {array exists}\
19 {wrong # args: should be "array option arrayName ?arg ...?"}\
20 {array, good subcommand, no array}
21
22 eval_is {array bork foo}\
23 {bad option "bork": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}\
24 {array, bad subcommand, bad array}
25
26 eval_is {
27 set b(c) 2
28 array exists b
29 } 1 {array exists yes}
30
31 eval_is {
32 set a 2
33 array exists a
34 } 0 {array exists no}
35
36 eval_is {array exists q} 0 {array exists missing}
37
38 eval_is {array exists a b}\
39 {wrong # args: should be "array exists arrayName"}\
40 {array exists too many args}
41
42 eval_is {
43 proc test {} {
44 array set foo [list 1 2 3 4]
45 return [array exists foo]
46 }
47 test
48 } 1 {array exists lexical}
49
50 eval_is {array size a b}\
51 {wrong # args: should be "array size arrayName"}\
52 {array size too many args}
53
54 eval_is {
55 catch {unset a}
56 set a(1) 1
57 array size a
58 } 1 {array size 1}
59
60 eval_is {
61 catch {unset a}
62 set a(1) 1; set a(2) 2
63 array size a
64 } 2 {array size 2}
65
66 eval_is {
67 catch {unset a}
68 set a 1
69 array size a
70 } 0 {}
71
72 eval_is {
73 catch {unset a}
74 array set a [list a b]
75 set a(a)
76 } b {array set list}
77
78 eval_is {
79 catch {unset a}
80 array set a [list a b c d e f]
81 list $a(a) $a(c) $a(e)
82 } {b d f} {array set multi list}
83
84 eval_is {
85 catch {unset a}
86 set a(a) b
87 array set a [list c d e f]
88 list $a(a) $a(c) $a(e)
89 } {b d f} {array set preserve old values}
90
91 eval_is {
92 catch {unset a}
93 array set a {a b}
94 set a(a)
95 } b {array set}
96
97 eval_is {
98 catch {unset a}
99 array set a {a b c d e f}
100 list $a(a) $a(c) $a(e)
101 } {b d f} {array set multi}
102
103 eval_is {array set a a}\
104 {list must have an even number of elements}\
105 {array set uneven}
106
107 eval_is {array set a [list a b]} \
108 {}\
109 {array set return value}
110
111 eval_is {
112 catch {unset a}
113 set a 44
114 array set a {1 2 3 4}
115 } {can't set "a(1)": variable isn't array}\
116 {array set not array}
117
118 eval_is {
119 catch {unset a}
120 array set a {}
121 array get a
122 } {} {array set with empty list}
123
124 eval_is {
125 catch {unset a}
126 array set a [list a b]
127 array get a
128 } {a b} {array get}
129
130 eval_is {
131 catch {unset a}
132 array set a [list a {b c}]
133 array get a
134 } {a {b c}} {array get, insure list results}
135
136 eval_is {
137 catch {unset a}
138 array set a [list a b c d]
139 array get a a
140 } {a b} {array get with pattern}
141
142 eval_is {
143 catch {unset a}
144 array set a [list apple 1 orange 2 aardvark 3]
145 lsort [array get a a*]
146 } {1 3 aardvark apple}\
147 {array get, with pattern}
148
149 eval_is {
150 catch {unset a}
151 array set a [list apple 1 orange 2 aardvark 3]
152 array get a zippy*
153 } {} {array get, with bad pattern}
154
155 eval_is {
156 catch {unset a}
157 array get a
158 } {} {array get, no array}
159
160 eval_is {
161 catch {unset a}
162 set a 2
163 array get a
164 } {} {array get, non array}
165
166 eval_is {
167 catch {unset a}
168 array get a a
169 } {} {array get, bad array with pattern}
170
171 eval_is {array get a b c}\
172 {wrong # args: should be "array get arrayName ?pattern?"}\
173 {array get, too many args}
174
175 eval_is {
176 catch {unset a}
177 array set a [list a b]
178 list [array unset a] [array get a]
179 } {{} {}} {array unset, effect & return value}
180
181 eval_is {
182 catch {unset a}
183 array set a [list a b c d]
184 list [array unset a a] [array get a]
185 } {{} {c d}} {array unset, with pattern & return value}
186
187 eval_is {
188 catch {unset a}
189 array set a [list apple 1 orange 2 aardvark 3]
190 list [array unset a a*] [array get a]
191 } {{} {orange 2}} {array unset with pattern}
192
193 eval_is {
194 catch {unset a}
195 array set a [list apple 1 orange 2 aardvark 3]
196 list [array unset a zippy*] [lsort [array get a]]
197 } {{} {1 2 3 aardvark apple orange}}\
198 {array unset, with bad pattern}
199
200 eval_is {
201 catch {unset a}
202 array unset a
203 } {} {array unset, bad array}
204
205 eval_is {
206 catch {unset a}
207 array unset a monkey*
208 } {} {array unset, bad array, pattern}
209
210 eval_is {
211 array unset monkey my monkey monkey
212 } {wrong # args: should be "array unset arrayName ?pattern?"}\
213 {array unset, too many args}
214
215 eval_is {
216 catch {unset a}
217 array names a
218 } {} {array names, no array}
219
220 eval_is {
221 catch {unset a}
222 array set a [list {b c} a]
223 array names a
224 } {{b c}} {array names, insure list results}
225
226 eval_is {array names a b c} \
227 {bad option "b": must be -exact, -glob, or -regexp} \
228 {array names, bad option}
229
230 eval_is {array names a b c d}\
231 {wrong # args: should be "array names arrayName ?mode? ?pattern?"}\
232 {array names, too many args}
233
234 eval_is {
235 catch {unset a}
236 set a(monkey) see
237 array names a
238 } {monkey} {array names, no pattern}
239
240 eval_is {
241 catch {unset a}
242 set a(monkey1) see
243 set a(monkey2) do
9a1a9f8 [array names] doesn't return results sorted, so to test, sort explici…
wcoleda authored
244 lsort [array names a monkey*]
d6ead2c Initial commit from r31638 of https://svn.perl.org/parrot/trunk/langu…
wcoleda authored
245 } {monkey1 monkey2}\
246 {array names, default glob pattern}
247
248 eval_is {
249 catch {unset a}
250 set a(monkey1) see
251 set a(monkey2) do
252 array names a cat*
253 } {} {array names, default glob pattern failure}
254
255 eval_is {
256 catch {unset a}
257 set a(monkey1) see
258 set a(monkey2) do
9a1a9f8 [array names] doesn't return results sorted, so to test, sort explici…
wcoleda authored
259 lsort [array names a -glob monkey*]
d6ead2c Initial commit from r31638 of https://svn.perl.org/parrot/trunk/langu…
wcoleda authored
260 } {monkey1 monkey2} {array names, explicit glob pattern}
261
262 eval_is {
263 catch {unset a}
264 set a(monkey1) see
265 set a(monkey2) do
266 array names a -glob cat*
267 } {} {array names, explicit glob pattern failure}
268
269 eval_is {
270 catch {unset a}
271 set a(monkey1) see
272 set a(monkey2) do
273 array names a -exact monkey1
274 } {monkey1} {array names, explicit exact match}
275
276 eval_is {
277 catch {unset a}
278 set a(monkey1) see
279 set a(monkey2) do
280 array names a -exact cat5
281 } {} {array names, explicit exact match failure}
282
283 eval_is {
284 catch {unset a}
285 set a(monkey1) see
286 set a(monkey2) do
287 set a(ferret) don't
9a1a9f8 [array names] doesn't return results sorted, so to test, sort explici…
wcoleda authored
288 lsort [array names a -regexp ^mon.*]
d6ead2c Initial commit from r31638 of https://svn.perl.org/parrot/trunk/langu…
wcoleda authored
289 } {monkey1 monkey2} {array names, explicit regexp match}
290
291 eval_is {
292 catch {unset a}
293 set a(monkey1) see
294 set a(monkey2) do
295 array names a -regexp cat
296 } {} {array names, explicit regexp match failure}
Something went wrong with that request. Please try again.