1#!./parrot
2# Copyright (C) 2001-2007, Parrot Foundation.
3
4=head1 NAME
5
6t/pmc/resizablebooleanarray.t - testing the ResizableBooleanArray PMC
7
8=head1 SYNOPSIS
9
10    % prove t/pmc/resizablebooleanarray.t
11
12=head1 DESCRIPTION
13
14Tests C<ResizableBooleanArray> PMC. Checks size, sets various elements, including
15out-of-bounds test. Checks INT and PMC keys.
16
17=cut
18
19.include 'except_types.pasm'
20.include 'fp_equality.pasm'
21
22.sub main :main
23
24    .include 'test_more.pir'
25
26    plan(68)
27
28    setting_array_size()
29    setting_first_element()
30    setting_second_element()
31    setting_negatively_indexed_element()
32    getting_negatively_indexed_element()
33    setting_oob_element()
34    getting_oob_element()
35    set_via_pmc_keys_access_via_ints()
36    set_via_int_access_via_key_pmc()
37    interface_check()
38    push_integer()
39    push_and_pop()
40    pop_bounds_check()
41    shift_and_unshift()
42    shift_bounds_check()
43    aerobics()
44    direct_access()
45    sparse_access()
46    check_for_zeroedness()
47    pop_into_sparse()
48    clone_empty()
49    clone_tests()
50    alternate_clone_tests()
51    get_iter_test()
52
53.end
54
55
56.sub setting_array_size
57
58    new $P0, ['ResizableBooleanArray']
59
60    is($P0, 0, "new ResizableBooleanArray is empty")
61
62    $P0 = 1
63    is($P0, 1, "int assignment to RBA works")
64
65    $P0 = 5
66    is($P0, 5, "another int assignment to RBA works")
67
68    $P0 = 50
69    is($P0, 50, "yet another int assignment to RBA works")
70
71    $P0 = 7
72    is($P0, 7, "shrinking via int assignment to RBA works")
73
74    new $P1, ['ExceptionHandler']
75    set_label $P1, caught
76    $P1.'handle_types'(.EXCEPTION_OUT_OF_BOUNDS)
77    push_eh $P1
78    $P0 = -1
79    ok(0, "no exception caught for setting negative size")
80    .return()
81caught:
82    ok(1, "caught exception on setting negative size")
83.end
84
85
86.sub setting_first_element
87
88    new $P0, ['ResizableBooleanArray']
89    $P0 = 1
90
91    $P0[0] = -7
92    $I0 = $P0[0]
93    is($I0, 1, "negative int -> boolean conversion is ok")
94
95    $P0[0] = 3.7
96    $N0 = $P0[0]
97    is($N0, 1.0, "float -> boolean conversion is ok")
98
99    $P0[0] = 17
100    $I0 = $P0[0]
101    is($I0, 1, "positive int -> boolean conversion is ok")
102
103.end
104
105.sub setting_second_element
106
107    new $P0, ['ResizableBooleanArray']
108    $P0 = 2
109
110    $P0[1] = -7
111    $I0 = $P0[1]
112    is($I0, 1, "negative int -> boolean conversion is ok")
113
114    $P0[1] = 3.7
115    $N0 = $P0[1]
116    is($N0, 1.0, "float -> boolean conversion is ok")
117
118    $P0[1] = 17
119    $I0 = $P0[1]
120    is($I0, 1, "positive int -> boolean conversion is ok")
121
122.end
123
124
125.sub setting_negatively_indexed_element
126    new $P0, ['ResizableBooleanArray']
127    new $P1, ['ExceptionHandler']
128
129    set_label $P1, caught
130    $P1.'handle_types'(.EXCEPTION_OUT_OF_BOUNDS)
131    push_eh $P1
132
133    set $P0[-1], 1
134    pop_eh
135
136    ok(0, "no exception caught for negative index access")
137    goto end
138
139caught:
140    ok(1, "caught exception on negative index access")
141end:
142.end
143
144
145.sub getting_negatively_indexed_element
146    new $P0, ['ResizableBooleanArray']
147    set $P0, 1
148
149    set $I0, $P0[-1]
150    is($I0, 0, "negative index retrieval is 0")
151
152    new $P1, ['ExceptionHandler']
153    set_label $P1, caught
154    $P1.'handle_types'(.EXCEPTION_OUT_OF_BOUNDS)
155    push_eh $P1
156    set $I0, $P0[-2]
157    ok(0, "no exception caught for negative index out of range access")
158    .return()
159caught:
160    pop_eh
161    ok(1, "caught exception on negative index out of range access")
162.end
163
164
165.sub setting_oob_element
166    new $P0, ['ResizableBooleanArray']
167
168    set $P0[1], -7
169    set $I0, $P0[1]
170    is($I0, 1, "negative oob assignment is fine")
171
172    $P0[2] = 3.7
173    $N0 = $P0[2]
174    is($N0, 1.0, "float -> boolean conversion w/ oob assignment is ok")
175
176    $P0[3] = 17
177    $I0 = $P0[3]
178    is($I0, 1, "positive int -> boolean conversion w/ oob assignment is ok")
179
180.end
181
182
183.sub getting_oob_element
184    new $P0, ['ResizableBooleanArray']
185    set $P0, 1
186
187    set $I0, $P0[1]
188    ok(1, "setting/getting an oob element worked")
189.end
190
191
192.sub set_via_pmc_keys_access_via_ints
193     new $P0, ['ResizableBooleanArray']
194     new $P1, ['Key']
195
196     set $P1, 0
197     set $P0[$P1], 25
198
199     set $P1, 1
200     set $P0[$P1], 2.5
201
202     set $P1, 2
203     set $P0[$P1], "17"
204
205     set $I0, $P0[0]
206     is($I0, 1, "key set, int get worked")
207
208     set $N0, $P0[1]
209     is($N0, 1.0, "key set, num get worked")
210
211     set $S0, $P0[2]
212     is($S0, "1", "key set, string get worked")
213.end
214
215.sub set_via_int_access_via_key_pmc
216     new $P0, ['ResizableBooleanArray']
217     set $P0, 1
218
219     set $P0[25], 125
220     set $P0[128], 10.2
221     set $P0[513], "17"
222     new $P1, ['Integer']
223     set $P1, 123456
224     set $P0[1023], $P1
225
226     new $P2, ['Key']
227     set $P2, 25
228     set $I0, $P0[$P2]
229     is($I0, 1, "int set, key get worked")
230
231     set $P2, 128
232     set $N0, $P0[$P2]
233     is($N0, 1.0, "int set, key get worked")
234
235     set $P2, 513
236     set $S0, $P0[$P2]
237     is($S0, "1", "int set key get worked")
238
239     set $P2, 1023
240     set $P3, $P0[$P2]
241     is($P3, 1, "int set, key get worked")
242.end
243
244.sub interface_check
245    .local pmc pmc1
246    pmc1 = new ['ResizableBooleanArray']
247    .local int bool1
248    does bool1, pmc1, "scalar"
249    is(bool1, 0, "RBA doesn't do 'scalar'")
250    does bool1, pmc1, "array"
251    is(bool1, 1, "RBA does 'array'")
252    does bool1, pmc1, "no_interface"
253    is(bool1, 0, "RBA doesn't do 'no_interface'")
254.end
255
256.sub push_integer
257    .local pmc pmc1
258    .local string last
259    .local int elements
260
261    pmc1 = new ['ResizableBooleanArray']
262    pmc1[9999] = 0
263    push pmc1, 10001
264    elements = pmc1
265    is(elements, 10001, "element count looks good")
266
267    last = pmc1[10000]
268    is(last, 1, "last element has the right value")
269.end
270
271.sub push_and_pop
272    .local int i, i_elem
273    .local pmc pmc_arr
274    .local int elements
275
276    i = 1
277    pmc_arr = new ['ResizableBooleanArray']
278
279    is(pmc_arr, 0, "new RBA doesn't have any elements")
280
281    push pmc_arr, i
282    is(pmc_arr, 1, "RBA with 1 element says it has 1 element")
283
284    push pmc_arr, 0
285    is(pmc_arr, 2, "RBA with 2 elements says it has 2 elements")
286
287    i_elem = pop pmc_arr
288    is(i_elem, 0, "pop popped the right value")
289    is(pmc_arr, 1, "RBA has 1 element, as expected")
290
291    i_elem = pop pmc_arr
292    is(i_elem, 1, "pop popped the right value again")
293    is(pmc_arr, 0, "RBA is now empty, expectedly")
294
295    pmc_arr = 62
296    push pmc_arr, 0
297    push pmc_arr, 1
298    push pmc_arr, 0
299    push pmc_arr, 1
300    i_elem = pop pmc_arr
301    i_elem = pop pmc_arr
302    i_elem = pop pmc_arr
303    is(i_elem, 1, "pop popped the right thing again")
304    is(pmc_arr, 63, "RBA has expected size")
305.end
306
307
308.sub pop_bounds_check
309    $P0 = new ['ResizableBooleanArray']
310    $P1 = new ['ExceptionHandler']
311
312    set_label $P1, caught
313    $P1.'handle_types'(.EXCEPTION_OUT_OF_BOUNDS)
314    push_eh $P1
315    pop $I0, $P0
316    pop_eh
317    ok(0, "failed to catch an oob exception")
318    goto end
319caught:
320    ok(1, "caught an oob exception")
321end:
322.end
323
324
325.sub shift_and_unshift
326    .local int i, i_elem
327    .local pmc pmc_arr
328    .local int elements
329
330    i = 1
331    pmc_arr = new ['ResizableBooleanArray']
332
333    # No elements are set
334    is(pmc_arr, "", "stringification looks ok")
335
336    # Set two of the first three elements
337    pmc_arr[0] = 1
338    pmc_arr[2] = 1
339    is(pmc_arr, "101", "stringification w/ 3 elems is good")
340
341    # Unshift a "1"  element on
342    unshift pmc_arr, i
343    is(pmc_arr, "1101", "still ok")
344
345    # Unshift a "0"  element on
346    unshift pmc_arr, 0
347    is(pmc_arr, "01101", "still ok")
348
349    # Shift an element off
350    i_elem = shift pmc_arr
351    is(i_elem, 0, "shift shifted a 0")
352    is(pmc_arr, "1101", "stringification ok")
353
354    # Shift an element off
355    i_elem = shift pmc_arr
356    is(i_elem, 1, "shift shifted a 1")
357    is(pmc_arr, "101", "stringification ok")
358
359    # Resize the array
360    pmc_arr = 25
361    is(pmc_arr, "1010000000000000000000000", "long stringification is correct")
362
363    # Unshift 4 elements on
364    unshift pmc_arr, 1
365    unshift pmc_arr, 1
366    unshift pmc_arr, 0
367    unshift pmc_arr, 1
368    is(pmc_arr, "10111010000000000000000000000", "longer stringification is ok")
369
370    # Shift 3 elements off
371    i_elem = shift pmc_arr
372    i_elem = shift pmc_arr
373    i_elem = shift pmc_arr
374    is(i_elem, 1, "shift shifted the right thing")
375    is(pmc_arr, "11010000000000000000000000", "stringification is still ok")
376
377    # Set same size array is currently
378    pmc_arr = 26
379    is(pmc_arr, "11010000000000000000000000", "noop size change did nothing")
380
381    # Set 101th element
382    pmc_arr[100] = 1
383    is(pmc_arr, 101, "setting pmc_arr[100] changed size to 101")
384
385    # Shift off 99 elements
386    .local int counter
387    counter = 98
388shift_loop:
389    i_elem = shift pmc_arr
390    dec counter
391    if counter > 0 goto shift_loop
392
393    is(i_elem, 0, "all peachy")
394    is(pmc_arr, "001", "all's well that ends well")
395.end
396
397
398.sub shift_bounds_check
399    $P0 = new ['ResizableBooleanArray']
400    $P1 = new ['ExceptionHandler']
401
402    set_label $P1, caught
403    $P1.'handle_types'(.EXCEPTION_OUT_OF_BOUNDS)
404    push_eh $P1
405
406    shift $I0, $P0
407    ok(0, "no OOB exception thrown")
408    goto end
409
410caught:
411    ok(1, "OOB exception thrown and caught")
412
413end:
414.end
415
416.sub aerobics
417    .local pmc jmpstack
418    jmpstack = new 'ResizableIntegerArray'
419    new $P0, ['ResizableBooleanArray']
420    set $I10, 10000
421
422    set $I1, 0
423    set $I0, 0
424  buildup:
425    ge $I0, $I10, postBuildUp
426
427    mod $I4, $I1, 2
428    push $P0, $I4
429    add $I1, 1    # Push $P0, mod $I1++, 2
430    mod $I4, $I1, 2
431    push $P0, $I4
432    add $I1, 1    # Push $P0, mod $I1++, 2
433    mod $I4, $I1, 2
434    push $P0, $I4
435    add $I1, 1    # Push $P0, mod $I1++, 2
436
437    pop $I2, $P0
438    mul $I3, $I0, 3
439    add $I3, 2
440    mod $I3, 2
441    ne $I2, $I3, errFirstPop  # fail if pop != mod $I0 * 3 + 2, 2
442
443    pop $I2, $P0
444    mul $I3, $I0, 3
445    add $I3, 1
446    mod $I3, 2
447    ne $I2, $I3, errSecondPop  # fail if pop != mod $I0 * 3 + 1, 2
448
449    set $I2, $P0
450    add $I3, $I0, 1
451    ne $I2, $I3, errBuildLen   # fail if length != $I0 + 1
452
453    add $I0, 1
454    branch buildup
455  postBuildUp:
456
457    set $I0, 0
458  checkBuildUpLeft:
459    ge $I0, $I10, postCheckBuildUpLeft
460    set $I2, $P0[$I0]
461    mul $I3, $I0, 3
462    mod $I3, 2
463    ne $I2, $I3, errLeftGet
464    add $I0, 1
465    branch checkBuildUpLeft
466  postCheckBuildUpLeft:
467
468    mul $I0, $I10, -1
469  checkBuildUpRight:
470    ge $I0, 0, postCheckBuildUpRight
471    set $I2, $P0[$I0]
472    add $I3, $I0, $I10
473    mul $I3, 3
474    mod $I3, 2
475    ne $I2, $I3, errRightGet
476    add $I0, 1
477    branch checkBuildUpRight
478  postCheckBuildUpRight:
479
480    set $I0, $I10
481  tearDown:
482    le $I0, 0, postTearDown
483    pop $I2, $P0
484    sub $I3, $I0, 1
485    mod $I3, 2
486    ne $I2, $I3, errTearDown
487
488    sub $I0, 1
489    branch tearDown
490  postTearDown:
491
492    ok(1, "aerobics completed successfully")
493    .return()
494  errFirstPop:
495    print "FAILED: first pop\n"
496    local_branch jmpstack, info
497    .return()
498  errSecondPop:
499    print "FAILED: second pop\n"
500    local_branch jmpstack, info
501    .return()
502  errBuildLen:
503    print "FAILED: buildup length\n"
504    local_branch jmpstack, info
505    .return()
506  errLeftGet:
507    print "FAILED: left get\n"
508    local_branch jmpstack, info
509    .return()
510  errRightGet:
511    print "FAILED: right get\n"
512    local_branch jmpstack, info
513    .return()
514  errTearDown:
515    print "FAILED: tear down cap\n"
516    local_branch jmpstack, info
517    .return()
518  info:
519    ok(0, "aerobics goof:")
520    print "#Found: "
521    print $I2
522    print "\n#Wanted: "
523    print $I3
524    print "\n"
525    local_return jmpstack
526.end
527
528
529.sub direct_access
530    new $P0, ['ResizableBooleanArray']
531    set $I10, 550000
532    set $I0, 1
533lp1:
534    add $I1, $I0, 5
535    mod $I2, $I1, 2
536    set $P0[$I0], $I2
537    add $I3, $I1, $I0
538    mod $I2, $I3, 2
539    push $P0, $I2
540    shl $I0, $I0, 1
541    inc $I0
542    le $I0, $I10, lp1
543
544    set $I0, 1
545lp2:
546    add $I1, $I0, 5
547    mod $I5, $I1, 2
548    # check at $I0
549    set $I2, $P0[$I0]
550    ne $I2, $I5, err
551    add $I4, $I0, 1
552    # and pushed value at $I0+1
553    set $I4, $P0[$I4]
554    add $I3, $I1, $I0
555    mod $I5, $I3, 2
556    ne $I5, $I4, err
557
558    shl $I0, $I0, 1
559    inc $I0
560    le $I0, $I10, lp2
561    ok(1, "direct access check passed")
562    .return()
563err:
564    print "not ok "
565    print $I0
566    print " "
567    print $I1
568    print " "
569    print $I2
570    print " "
571    print $I3
572    print " "
573    print $I4
574    print " "
575    print $I5
576    print " "
577    print $I6
578    print " "
579    print $I7
580    print "\n"
581
582.end
583
584
585.sub sparse_access
586    new $P0, ['ResizableBooleanArray']
587    set $I10, 110000
588    set $I0, 1
589  lp1:
590    add $I1, $I0, 5
591    mod $I9, $I1, 2
592    set $P0[$I0], $I9
593    add $I3, $I1, $I0
594    mod $I9, $I3, 2
595    push $P0, $I9
596    shl $I0, $I0, 1
597    inc $I0
598    le $I0, $I10, lp1
599
600    set $I0, 1
601  lp2:
602    add $I1, $I0, 5
603    mod $I9, $I1, 2
604    # check at $I0
605    set $I2, $P0[$I0]
606    ne $I2, $I9, err
607    add $I4, $I0, 1
608    # and pushed value at $I0+1
609    set $I4, $P0[$I4]
610    add $I3, $I1, $I0
611    mod $I9, $I3, 2
612    ne $I9, $I4, err
613
614    shl $I0, $I0, 1
615    inc $I0
616    le $I0, $I10, lp2
617    ok(1, "sparse access tests ok")
618
619    # now repeat and fill some holes
620
621    set $I0, 777
622  lp3:
623    add $I1, $I0, 5
624    mod $I9, $I1, 2
625    set $P0[$I0], $I9
626    add $I0, $I0, 666
627    le $I0, $I10, lp3
628
629    set $I0, 777
630  lp4:
631    add $I1, $I0, 5
632    mod $I9, $I1, 2
633    # check at $I0
634    set $I2, $P0[$I0]
635    ne $I2, $I9, err
636
637    add $I0, $I0, 666
638    le $I0, $I10, lp4
639    ok(1, "sparse access tests still ok")
640    .return()
641  err:
642    print "not ok "
643    print $I0
644    print " "
645    print $I1
646    print " "
647    print $I2
648    print " "
649    print $I3
650    print " "
651    print $I4
652    print "\n"
653
654.end
655
656
657.sub check_for_zeroedness
658    new $P0, ['ResizableBooleanArray']
659    set $I0, 0
660lp1:
661    push $P0, 0
662    inc $I0
663    lt $I0, 100, lp1
664
665    set $I2, 10000
666    set $P0, $I2
667lp2:
668    set $I1, $P0[$I0]
669    ne $I1, 0, err
670    inc $I0
671    lt $I0, $I2, lp2
672    ok(1, "zeroedness tests passed")
673    .return()
674err:
675    ok(0, "zeroedness tests failed")
676    print "#Found non-zero value "
677    print $I1
678    print " at "
679    say $I0
680.end
681
682
683.sub pop_into_sparse
684    new $P0, ['ResizableBooleanArray']
685    set $I10, 100
686    set $I0, 0
687    # push some values at start
688loop1:
689    mod $I5, $I0, 2
690    push $P0, $I5
691    inc $I0
692    lt $I0, $I10, loop1
693
694    # create sparse
695    set $I0, 100000
696    set $I1, 1000
697    mod $I5, $I1, 2
698    #set $P0[$I0], $I1
699    set $P0[$I0], $I5
700    inc $I1
701loop2:
702    # push some values after hole
703    mod $I5, $I1, 2
704    push $P0, $I5
705    inc $I1
706    le $I1, 1100, loop2
707    dec $I1
708
709    set $I3, $P0
710lp3:
711    set $I4, $P0
712    ne $I3, $I4, err1
713    pop $I2, $P0
714    dec $I3
715    mod $I5, $I1, 2
716    ne $I2, $I5, err2
717    gt $I3, $I0, cont1
718    lt $I3, $I10, cont1
719    set $I1, 0
720
721    gt $I3, $I10, lp3
722    set $I1, $I10
723
724cont1:
725    dec $I1
726    eq $I1, 0, ok
727    branch lp3
728ok:
729    ok(1, "pop into sparse tests passed")
730    .return()
731    err1:   set $S0, "len"
732    branch err
733err2:
734    set $S0, "val"
735err:
736    ok(0, "pop into sparse tests failed")
737    print "#nok "
738    print $S0
739    print " "
740    print $I0
741    print " "
742    print $I1
743    print " "
744    print $I2
745    print " "
746    print $I3
747    print " "
748    print $I4
749    print " "
750    print $I5
751.end
752
753.sub clone_empty
754    .local pmc rba1, rba2
755    .local int i
756    rba1 = new ['ResizableBooleanArray']
757    rba2 = clone rba1
758    i = elements rba2
759    is(i, 0, "clone empty passed")
760.end
761
762.sub clone_tests
763    .local pmc rba1, rba2
764    .local int i, failed
765    failed = 0
766    rba1 = new ['ResizableBooleanArray']
767
768    rba1[0]    = 1
769    rba1[5000] = 1
770
771    rba2 = clone rba1
772
773    i = rba1[5000]
774    if i == 1 goto ok_0
775    failed = 1
776
777ok_0:
778    i = pop rba1
779    if i == 1 goto ok_1
780    failed = 2
781
782ok_1:
783    i = rba1
784    if i == 5000 goto ok_2
785    failed = 3
786
787ok_2:
788    i = pop rba2
789    if i == 1 goto ok_3
790    failed = 4
791
792ok_3:
793    i = rba2
794    if i == 5000 goto ok_4
795    failed = 5
796
797ok_4:
798    i = rba2[5000] #should be undefined, i.e. 0
799    if i == 0 goto ok_5
800    failed = 6
801
802ok_5:
803    i = pop rba2 #same as previous
804    if i == 0 goto ok_6
805    failed = 7
806    $S0 = rba2
807    say $S0
808
809ok_6:
810    is(failed, 0, "all clone tests passed")
811.end
812
813.sub alternate_clone_tests
814    .local pmc rba1, rba2
815    .local int i, failed
816    failed = 0
817    rba1 = new ['ResizableBooleanArray']
818
819    rba1[0]    = 1
820    rba1[4]    = 1
821    rba1[5004] = 1
822    i = shift rba1
823    i = shift rba1
824    i = shift rba1
825    i = shift rba1
826
827    rba2 = clone rba1
828
829    i = rba1[5000]
830    if i == 1 goto ok_0
831    failed = 1
832
833ok_0:
834    i = pop rba1
835    if i == 1 goto ok_1
836    failed = 2
837
838ok_1:
839    i = rba1
840    if i == 5000 goto ok_2
841    failed = 3
842
843ok_2:
844    i = pop rba2
845    if i == 1 goto ok_3
846    failed = 4
847
848ok_3:
849    i = rba2
850    if i == 5000 goto ok_4
851    failed = 5
852
853ok_4:
854    i = rba2[5000] #should be undefined, i.e. 0
855    if i == 0 goto ok_5
856    failed = 6
857
858ok_5:
859    i = pop rba2 #same as previous
860    if i == 0 goto ok_6
861    failed = 7
862
863ok_6:
864    is(failed, 0, "all alternate clone tests passed")
865.end
866
867.sub get_iter_test
868    $P0 = new ['ResizableBooleanArray']
869    $P0 = 3
870    $P0[0] = 1
871    $P0[1] = 0
872    $P0[2] = 1
873    $P1 = iter $P0
874loop:
875    unless $P1 goto loop_end
876    $S2 = shift $P1
877    $S0 = concat $S0, $S2
878    goto loop
879  loop_end:
880    is($S0, "101", "get_iter works")
881.end
882
883
884
885# Local Variables:
886#   mode: pir
887#   fill-column: 100
888# End:
889# vim: expandtab shiftwidth=4 ft=pir:
890