1#!./parrot
2# Copyright (C) 2001-2014, Parrot Foundation.
3
4=head1 NAME
5
6t/pmc/fixedintegerarray.t - FixedIntegerArray PMC
7
8=head1 SYNOPSIS
9
10    % prove t/pmc/fixedintegerarray.t
11
12=head1 DESCRIPTION
13
14Tests C<FixedIntegerArray> PMC. Checks size, sets various elements, including
15out-of-bounds test. Checks INT and PMC keys.
16
17=cut
18
19.sub 'main' :main
20    .include 'test_more.pir'
21
22    test_set_size()
23    test_reset_size()
24    test_set_first()
25    test_set_second()
26    test_out_of_bounds()
27    test_set_via_pmc()
28    test_get_via_pmc()
29    test_interface_done()
30    test_get_iter()
31    test_equality()
32    test_repr()
33    test_sort()
34    test_new_style_init()
35    test_invalid_init_tt1509()
36    test_custom_cmp()
37
38    done_testing()
39.end
40
41.sub 'test_new_style_init'
42    $P0 = new 'FixedIntegerArray', 10
43
44    $I0 = $P0
45    is($I0, 10, "New style init creates the correct # of elements")
46
47    $P0 = new ['FixedIntegerArray'], 10
48
49    $I0 = $P0
50    is($I0, 10, "New style init creates the correct # of elements for a key constant")
51.end
52
53.sub 'test_set_size'
54    $P0 = new ['FixedIntegerArray']
55
56    $I0 = $P0
57    is($I0, 0, "Fresh array has 0 elements")
58
59    $P0 = 42
60    $I0 = $P0
61    is($I0, 42, "Size was set correctly")
62.end
63
64.sub 'test_reset_size'
65    $P0 = new ['FixedIntegerArray']
66
67    $I0 = 1
68    $P0 = 1
69    push_eh handled
70    $P0 = 2
71    $I0 = 0
72  handled:
73    pop_eh
74
75    ok($I0, "Can't resize")
76.end
77
78.sub 'test_set_first'
79    $P0 = new ['FixedIntegerArray']
80    $P0 = 1
81
82    $P0[0] = -7
83    $I0 = $P0[0]
84    is($I0, -7, "First element set to integer properly")
85
86    $P0[0] = 3.7
87    $I0 = $P0[0]
88    is($I0, 3, "First element set to number properly")
89
90    $P0[0] = "17"
91    $I0 = $P0[0]
92    is($I0, 17, "First element set to string properly")
93.end
94
95.sub 'test_set_second'
96    $P0 = new ['FixedIntegerArray']
97    $P0 = 2
98
99    $P0[1] = -7
100    $I0 = $P0[1]
101    is($I0, -7, "Second element set to integer properly")
102
103    $P0[1] = 3.7
104    $I0 = $P0[1]
105    is($I0, 3, "Second element set to number properly")
106
107    $P0[1] = "17"
108    $I0 = $P0[1]
109    is($I0, 17, "Second element set to string properly")
110.end
111
112
113.sub 'test_out_of_bounds'
114    $P0 = new ['FixedIntegerArray']
115    $P0 = 1
116
117    $I0 = 1
118    push_eh handle_set
119    $P0[2] = 7
120    $I0 = 0
121  handle_set:
122    ok($I0, "Can't set out-of-bounds element")
123
124    $P0[-1] = 7
125    $I0 = $P0[-1]
126    is($I0, 7, "Can set and get element on negative index")
127
128    $I0 = 1
129    push_eh handle_get
130    $I1 = $P0[2]
131    $I0 = 0
132  handle_get:
133    ok($I0, "Can't get out-of-bounds element")
134
135    $I0 = 1
136    push_eh handle_get_negative
137    $I1 = $P0[-4]
138    $I0 = 0
139  handle_get_negative:
140    ok($I0, "Can't get negative out-of-bounds element")
141.end
142
143# Set via PMC keys, access via INTs
144.sub 'test_set_via_pmc'
145    $P0 = new ['FixedIntegerArray']
146    $P0 = 3
147
148    $P1 = new ['Key']
149
150    $P1 = 0
151    $P0[$P1] = 25
152    $I0 = $P0[0]
153    is($I0, 25, "Set INTVAL via PMC Key works")
154
155    $P1 = 1
156    $P0[$P1] = 2.5
157    $I0 = $P0[1]
158    is($I0, 2, "Set FLOATVAL via PMC Key works")
159
160    $P1 = 2
161    $P0[$P1] = "17"
162    $I0 = $P0[2]
163    is($I0, 17, "Set STRING via PMC Key works")
164.end
165
166# Set via INTs, access via PMC Keys
167.sub 'test_get_via_pmc'
168    $P0 = new ['FixedIntegerArray']
169    $P0 = 1024
170
171    $P0[25]   = 125
172    $P0[128]  = 10.2
173    $P0[513]  = "17"
174
175    $P1 = new ['Integer']
176    $P1 = 123456
177    $P0[1023] = $P1
178
179    $P2 = new ['Key']
180
181    $P2 = 25
182    $I0 = $P0[$P2]
183    is($I0, 125, "Get INTVAL via Key works")
184
185    $P2 = 128
186    $N0 = $P0[$P2]
187    is($N0, 10.0, "Get FLOATVAL via Key works")
188
189    $P2 = 513
190    $S0 = $P0[$P2]
191    is($S0, "17", "Get STRING via Key works")
192
193    $P2 = 1023
194    $I0 = $P0[$P2]
195    is($I0, 123456, "Get INTVAL for stored PMC via Key works")
196
197.end
198
199.sub 'test_interface_done'
200    .local pmc pmc1
201    pmc1 = new ['FixedIntegerArray']
202    .local int bool1
203    does bool1, pmc1, "scalar"
204    nok(bool1, "Does not scalar")
205    does bool1, pmc1, "array"
206    ok(bool1, "Does array")
207    does bool1, pmc1, "no_interface"
208    nok(bool1, "Does not no_interface")
209.end
210
211.sub 'test_get_iter'
212    $P0 = new ['FixedIntegerArray']
213    $P0 = 3
214    $P0[0] = 42
215    $P0[1] = 43
216    $P0[2] = 44
217    $S0 = ""
218    $P1 = iter $P0
219  loop:
220    unless $P1 goto loop_end
221    $S2 = shift $P1
222    $S0 = concat $S0, $S2
223    goto loop
224  loop_end:
225    is($S0, "424344", "Iteration works")
226.end
227
228.sub 'test_equality'
229    .local pmc a1, a2, a3
230    a1 = new ['FixedIntegerArray']
231    a2 = new ['FixedIntegerArray']
232
233    is(a1, a2, "Empty arrays are equal")
234
235    a1 = 3
236    isnt(a1, a2, "Different size arrays aren't equal")
237
238    a2 = 3
239
240    a1[0] = 42
241    a2[0] = 42
242    is(a1, a2, "Equal with first element set")
243
244    a1[1] = 84
245    isnt(a1, a2, "Not equal when second element differ")
246
247    a2[1] = 84
248    is(a1, a2, "Equal when second element same")
249
250    a3 = new ['Complex']
251    isnt(a1, a3, "Different PMC type is not equal")
252.end
253
254.sub 'test_repr'
255    .local pmc a1
256    .local string r
257    a1 = new ['FixedIntegerArray']
258    a1 = 2
259    a1[0] = 7
260    a1[1] = 1
261    r = get_repr a1
262    is(r, '[ 7, 1 ]', 'get_repr')
263    r = a1
264    is(r, '[ 7, 1 ]', 'get_string')
265.end
266
267.sub 'test_new_style_init'
268    $P0 = new ['FixedIntegerArray'], 10
269
270    $I0 = $P0
271    is($I0, 10, "New style init creates the correct # of elements")
272.end
273
274.sub 'test_sort'
275    .local pmc a1, a2
276    a1 = new ['FixedIntegerArray'], 3
277    a1[0] = 7
278    a1[1] = 1
279    a1[2] = 5
280
281    a2 = new ['FixedIntegerArray'], 3
282    a2[0] = 1
283    a2[1] = 5
284    a2[2] = 7
285
286    a1.'sort'()
287    $I0 = iseq a1, a2
288    is($I0, 1, 'default sort')
289.end
290
291.sub test_invalid_init_tt1509
292    throws_substring(<<'CODE', 'illegal argument', 'New style init does not dump core for negative array lengths')
293    .sub main :main
294        $P0 = new ['FixedIntegerArray'], -10
295    .end
296CODE
297
298    throws_substring(<<'CODE', 'illegal argument', 'New style init (key constant) does not dump core for negative array lengths')
299    .sub main :main
300        $P0 = new 'FixedIntegerArray', -10
301    .end
302CODE
303.end
304
305.sub test_custom_cmp
306    $P0 = new ['FixedIntegerArray']
307    $P0 = 3
308    $P0[0] = 1
309    $P0[1] = 2
310    $P0[2] = 3
311    $P1 = get_global 'sorter'
312    $P0.'sort'($P1)
313    $S0 = join ' ', $P0
314    is( $S0, '1 2 3', 'FIA sorted with custom cmp function' )
315.end
316
317.sub sorter
318    .param pmc a
319    .param pmc b
320
321    $I0 = a > b
322    .return ($I0)
323.end
324
325
326
327# Local Variables:
328#   mode: pir
329#   fill-column: 100
330# End:
331# vim: expandtab shiftwidth=4 ft=pir:
332