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