t/pmc/resizablepmcarray.t

   1 #!./parrot
   2 # Copyright (C) 2001-2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/resizablepmcarray.t - testing the ResizablePMCArray PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/resizablepmcarray.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests C<ResizablePMCArray> PMC. Checks size, sets various elements, including
  16 out-of-bounds test. Checks INT and PMC keys.
  17
  18 =cut
  19
  20 .sub main :main
  21     .include 'fp_equality.pasm'
  22     .include 'test_more.pir'
  23
  24     plan(142)
  25
  26     resize_tests()
  27     negative_array_size()
  28     set_tests()
  29     exception_tests()
  30     set_keyed_get_keyed_tests()
  31     interface_check()
  32     inherited_sort_method()
  33     sort_subclass()
  34     push_pmc()
  35     push_int()
  36     push_string()
  37     shift_int()
  38     unshift_pmc()
  39     get_mro_tests()
  40     push_and_pop()
  41     unshift_and_shift()
  42     shift_empty()
  43     pop_empty()
  44     multikey_access()
  45     exists_and_defined()
  46     delete_keyed()
  47     get_rep()
  48     append_tests()
  49     splice_tests()
  50     splice_replace1()
  51     splice_replace2()
  52     iterate_subclass_of_rpa()
  53     method_forms_of_unshift_etc()
  54     sort_with_broken_cmp()
  55     addr_tests()
  56     equality_tests()
  57     sort_tailcall()
  58     push_to_subclasses_array()
  59 .end
  60
  61
  62 .sub resize_tests
  63     .local pmc p
  64     .local int is_ok, i
  65     p = new ['ResizablePMCArray']
  66
  67     i = p
  68     is_ok = i == 0
  69     ok(is_ok, "resize test (0)")
  70
  71     p = 1
  72     i = p
  73     is_ok = i == 1
  74     ok(is_ok, "resize test (1)")
  75
  76     p = 5
  77     i = p
  78     is_ok = i == 5
  79     ok(is_ok, "resize test (5)")
  80
  81     p = 9
  82     i = p
  83     is_ok = i == 9
  84     ok(is_ok, "resize test (9)")
  85
  86     p = 7
  87     i = p
  88     is_ok = i == 7
  89     ok(is_ok, "resize test (7)")
  90 .end
  91
  92
  93 .sub negative_array_size
  94     .local pmc p
  95     .local int is_ok, i
  96     p = new ['ResizablePMCArray']
  97     push_eh eh
  98     p = -1
  99     pop_eh
 100     ok(0, "exception not caught")
 101     goto end
 102 eh:
 103     ok(1, "exception caught")
 104 end:
 105 .end
 106
 107
 108 .sub set_tests
 109     .local pmc p
 110     .local int is_ok, i
 111     .local num n
 112     .local string s
 113
 114     p = new ['ResizablePMCArray']
 115     p = 1
 116
 117     p[0] = -7
 118     i = p[0]
 119     is_ok = i == -7
 120     ok(is_ok, "INTVAL assignment to first element")
 121
 122     p[0] = 3.7
 123     n = p[0]
 124     is_ok = n == 3.7
 125     ok(is_ok, "FLOATVAL assignment to first element")
 126
 127     p[0] = "muwhahaha"
 128     s = p[0]
 129     is_ok = s == "muwhahaha"
 130     ok(is_ok, "STRING assignment to first element")
 131
 132     p[1] = -7
 133     i = p[1]
 134     is_ok = i == -7
 135     ok(is_ok, "INTVAL assignment to second element")
 136
 137     p[1] = 3.7
 138     n = p[1]
 139     is_ok = n == 3.7
 140     ok(is_ok, "FLOATVAL assignment to second element")
 141
 142     p[1] = "muwhahaha"
 143     s = p[1]
 144     is_ok = s == "muwhahaha"
 145     ok(is_ok, "STRING assignment to second element")
 146
 147     p[10] = -7
 148     i = p[10]
 149     is_ok = i == -7
 150     ok(is_ok, "INTVAL assignment to last element")
 151
 152     p[10] = 3.7
 153     n = p[10]
 154     is_ok = n == 3.7
 155     ok(is_ok, "FLOATVAL assignment to last element")
 156
 157     p[10] = "muwhahaha"
 158     s = p[10]
 159     is_ok = s == "muwhahaha"
 160     ok(is_ok, "STRING assignment to last element")
 161 .end
 162
 163
 164 .sub exception_tests
 165     .local pmc rpa, i
 166
 167     rpa = new ['ResizablePMCArray']
 168     rpa = 1
 169     i = new ['Integer']
 170     i = 12345
 171
 172     push_eh eh1
 173     rpa[10] = i
 174     pop_eh
 175     goto no_eh1
 176 eh1:
 177     ok(0, "unwanted ex thrown for out-of-bounds index")
 178     goto test2
 179 no_eh1:
 180     ok(1, "no ex thrown for out-of-bounds index")
 181
 182 test2:
 183     rpa = 1
 184     push_eh eh2
 185     rpa[-10] = i
 186     pop_eh
 187     goto no_eh2
 188 eh2:
 189     ok(1, "ex thrown for negative index")
 190     goto test3
 191 no_eh2:
 192     ok(0, "no ex thrown for negative index")
 193
 194 test3:
 195     rpa = 1
 196     push_eh eh3
 197     i = rpa[10]
 198     pop_eh
 199     goto no_eh3
 200 eh3:
 201     ok(0, "unwanted ex thrown for out-of-bounds index")
 202     goto test4
 203 no_eh3:
 204     ok(1, "no ex thrown for out-of-bounds index")
 205
 206 test4:
 207     rpa = 1
 208     push_eh eh4
 209     i = rpa[-10]
 210     pop_eh
 211     goto no_eh4
 212 eh4:
 213     ok(1, "ex thrown for negative index")
 214     goto end
 215 no_eh4:
 216     ok(0, "no ex thrown for negative index")
 217 end:
 218 .end
 219
 220
 221 .sub set_keyed_get_keyed_tests
 222
 223     new $P0, ['ResizablePMCArray']
 224     new $P1, ['Key']
 225
 226     set $P1, 0
 227     set $P0[$P1], 25
 228
 229     set $P1, 1
 230     set $P0[$P1], 2.5
 231
 232     set $P1, 2
 233     set $P0[$P1], "bleep"
 234
 235     new $P2, ['String']
 236     set $P2, "Bloop"
 237     set $P1, 3
 238     set $P0[$P1], $P2
 239
 240     set $I0, $P0[0]
 241     is($I0, 25, "set int via Key PMC, get int via int")
 242
 243     set $N0, $P0[1]
 244     .fp_eq($N0, 2.5, OK1)
 245     ok(0, "set num via Key PMC, get num via int fails")
 246     goto NOK1
 247 OK1:
 248     ok(1, "set num via Key PMC, get num via int fails")
 249 NOK1:
 250
 251     set $S0, $P0[2]
 252     is($S0, "bleep", "set string via Key PMC, get string via int")
 253
 254     new $P3, ['Undef']
 255     set $P3, $P0[3]
 256     set $S0, $P3
 257     is($S0, "Bloop", "set PMC via Key PMC, get PMC via PMC")
 258
 259
 260     new $P0, ['ResizablePMCArray']
 261     set $P0, 1
 262
 263     set $P0[25], 125
 264     set $P0[128], 10.2
 265     set $P0[513], "cow"
 266     new $P1, ['Integer']
 267     set $P1, 123456
 268     set $P0[1023], $P1
 269
 270     new $P2, ['Key']
 271     set $P2, 25
 272     set $I0, $P0[$P2]
 273     is($I0, 125, "set int via int, get int via Key PMC")
 274
 275     set $P2, 128
 276     set $N0, $P0[$P2]
 277     .fp_eq($N0, 10.2, OK2)
 278     ok(0, "set num via int, get num via Key PMC")
 279     goto NOK2
 280 OK2:
 281     ok(1, "set num via int, get num via Key PMC")
 282 NOK2:
 283
 284     set $P2, 513
 285     set $S0, $P0[$P2]
 286     is($S0, "cow", "set string via int, get string via Key PMC")
 287
 288     set $P2, 1023
 289     set $P3, $P0[$P2]
 290     set $I1, $P3
 291     is($I1, 123456, "set int via int, get int via Key PMC")
 292
 293 .end
 294
 295
 296 .sub interface_check
 297     .local pmc p
 298     p = new ['ResizablePMCArray']
 299     .local int b
 300     does b, p, "scalar"
 301     is(b, 0 ,"ResizablePMCArray doesn't do scalar")
 302     does b, p, "array"
 303     is(b, 1, "ResizablePMCArray does array")
 304     does b, p, "no_interface"
 305     is(b, 0, "ResizablePMCArray doesn't do no_interface")
 306 .end
 307
 308
 309 .sub inherited_sort_method
 310     .local pmc ar
 311     ar = new ['ResizablePMCArray']
 312
 313     ar[0] = 10
 314     ar[1] = 2
 315     ar[2] = 5
 316     ar[3] = 9
 317     ar[4] = 1
 318
 319     .local pmc cmp_fun
 320     null cmp_fun
 321     ar."sort"(cmp_fun)
 322
 323     .local string sorted
 324     sorted = ''
 325     .local pmc it
 326     iter it, ar
 327 lp:
 328     unless it goto done
 329     $P0 = shift it
 330     $S0 = $P0
 331     concat sorted, $S0
 332     concat sorted, " "
 333     goto lp
 334 done:
 335     is(sorted, "1 2 5 9 10 ", "inherited sort method works")
 336 .end
 337
 338
 339 .sub sort_subclass
 340     .local pmc subrpa, arr
 341     subrpa = subclass ['ResizablePMCArray'], 'ssRPA'
 342     arr = new subrpa
 343     arr[0] = 'p'
 344     arr[1] = 'a'
 345     arr[2] = 'z'
 346     # Use a comparator that gives a reverse alphabetical order
 347     # to make sure sort is using it, and not some default from
 348     # elsewhere.
 349     .local pmc comparator
 350     comparator = get_global 'compare_reverse'
 351     arr.'sort'(comparator)
 352     .local string s, aux
 353     s = typeof arr
 354     concat s, ':'
 355     aux = join '-', arr
 356     concat s, aux
 357     is(s, 'ssRPA:z-p-a', "sort works in a pir subclass, TT #218")
 358 .end
 359
 360 .sub compare_reverse
 361     .param string a
 362     .param string b
 363     $I0 = cmp b, a
 364     .return($I0)
 365 .end
 366
 367
 368 .sub push_pmc
 369     .local pmc pmc_arr, pmc_9999, pmc_10000
 370     pmc_arr = new ['ResizablePMCArray']
 371     pmc_9999  = new ['Float']
 372     pmc_9999  = 10000.10000
 373     pmc_10000 = new ['Float']
 374     pmc_10000 = 123.123
 375     pmc_arr[9999] = pmc_9999
 376     push pmc_arr, pmc_10000
 377     .local int elements
 378     elements = pmc_arr
 379     is(elements, 10001, "element count is correct")
 380     .local pmc last
 381     last = pmc_arr[10000]
 382     is(last, 123.123, "last element has correct value")
 383 .end
 384
 385
 386 .sub push_int
 387     .local pmc pmc_arr, pmc_9999
 388     .local int int_10000
 389     pmc_arr = new ['ResizablePMCArray']
 390     pmc_9999  = new ['Float']
 391     pmc_9999  = 10000.10000
 392     int_10000 = 123
 393     pmc_arr[9999] = pmc_9999
 394     push pmc_arr, int_10000
 395     .local int elements
 396     elements = pmc_arr
 397     is(elements, 10001, "element count is correct")
 398     .local pmc last
 399     last = pmc_arr[10000]
 400     is(last, 123, "last element has correct value")
 401 .end
 402
 403
 404 .sub push_string
 405     .local pmc pmc_arr, pmc_9999
 406     .local string string_10000
 407     pmc_arr = new ['ResizablePMCArray']
 408     pmc_9999  = new ['Float']
 409     pmc_9999  = 10000.10000
 410     string_10000 = '123asdf'
 411     pmc_arr[9999] = pmc_9999
 412     push pmc_arr, string_10000
 413     .local int elements
 414     elements = pmc_arr
 415     is(elements, 10001, "element count is correct")
 416     .local pmc last
 417     last = pmc_arr[10000]
 418     is(last, "123asdf", "last element has correct value")
 419 .end
 420
 421
 422 .sub shift_int
 423     .local pmc pmc_arr, elem
 424     pmc_arr = new ['ResizablePMCArray']
 425     push pmc_arr, 4
 426     push pmc_arr, 3
 427     push pmc_arr, 2
 428     push pmc_arr, 1
 429     push pmc_arr, 0
 430
 431     .local int elements
 432
 433     elements = pmc_arr
 434     is(elements, 5, "element count is correct")
 435
 436     elem = shift pmc_arr
 437     is(elem, 4, "correct element unshifted")
 438     elements = pmc_arr
 439     is(elements, 4, "correct element count after unshifing")
 440
 441     elem = shift pmc_arr
 442     is(elem, 3, "correct element unshifted")
 443     elements = pmc_arr
 444     is(elements, 3, "correct element count after unshifing")
 445
 446     elem = shift pmc_arr
 447     is(elem, 2, "correct element unshifted")
 448     elements = pmc_arr
 449     is(elements, 2, "correct element count after unshifing")
 450
 451     elem = shift pmc_arr
 452     is(elem, 1, "correct element unshifted")
 453     elements = pmc_arr
 454     is(elements, 1, "correct element count after unshifing")
 455
 456     elem = shift pmc_arr
 457     is(elem, 0, "correct element unshifted")
 458     elements = pmc_arr
 459     is(elements, 0, "correct element count after unshifing")
 460
 461 .end
 462
 463 .sub unshift_pmc
 464     new $P0, ['ResizablePMCArray']
 465     new $P1, ['Integer']
 466     set $P1, 1
 467     new $P2, ['Integer']
 468     set $P2, 2
 469     new $P3, ['Integer']
 470     set $P3, 3
 471     unshift $P0, $P1
 472     unshift $P0, $P2
 473     unshift $P0, $P3
 474     elements $I0, $P0
 475     is($I0, 3, "element count is correct")
 476     set $P3, $P0[0]
 477     is($P3, 3, "element 0 has correct value")
 478     set $P3, $P0[1]
 479     is($P3, 2, "element 1 has correct value")
 480     set $P3, $P0[2]
 481     is($P3, 1, "element 2 has correct value")
 482 .end
 483
 484
 485 .sub get_mro_tests
 486     new $P0, ['ResizablePMCArray']
 487     $P1 = inspect $P0, 'mro'
 488     ok(1, "get_mro didn't explode")
 489     elements $I1, $P1
 490     null $I0
 491     $S1 = ''
 492 loop:
 493     set $P2, $P1[$I0]
 494     typeof $S0, $P2
 495     concat $S1, $S0
 496     concat $S1, ","
 497     inc $I0
 498     lt $I0, $I1, loop
 499
 500     is($S1, "ResizablePMCArray,FixedPMCArray,", "ResizablePMCArrays have the right MRO")
 501 .end
 502
 503
 504 .sub push_and_pop
 505     .local num f, f_elem
 506     .local int i, i_elem, elements
 507     .local pmc p, p_elem, pmc_arr
 508     .local string s, s_elem
 509
 510     f = 123.123
 511     i = 123
 512     p = new ['Float']
 513     p = 456.456
 514     s = "abc"
 515
 516     pmc_arr = new ['ResizablePMCArray']
 517
 518     elements = pmc_arr
 519     is(elements, 0, "element count of empty ResizablePMCArray is 0")
 520
 521     push pmc_arr, s
 522     push pmc_arr, p
 523     push pmc_arr, i
 524     push pmc_arr, f
 525
 526     elements = pmc_arr
 527     is(elements, 4, "element count after several push operations is correct")
 528
 529     f_elem = pop pmc_arr
 530     is(f_elem, 123.123000, "shifted float is correct")
 531
 532     i_elem = pop pmc_arr
 533     is(i_elem, 123, "shifted int is correct")
 534
 535     p_elem = pop pmc_arr
 536     is(p_elem, 456.456, "shifted PMC is correct")
 537
 538     s_elem = pop pmc_arr
 539     is(s_elem, "abc", "shifted string is correct")
 540     elements = pmc_arr
 541     is(elements, 0, "element count after several shift operations is correct")
 542
 543 .end
 544
 545
 546 .sub unshift_and_shift
 547     .local num f, f_elem
 548     .local int i, i_elem, elements
 549     .local pmc p, p_elem, pmc_arr
 550     .local string s, s_elem
 551
 552     f = 123.123
 553     i = 123
 554     p = new ['Float']
 555     p = 456.456
 556     s = "abc"
 557
 558     pmc_arr = new ['ResizablePMCArray']
 559
 560     elements = pmc_arr
 561     is(elements, 0, "empty RPA has 0 elements")
 562
 563     unshift pmc_arr, f
 564     unshift pmc_arr, i
 565     unshift pmc_arr, p
 566     unshift pmc_arr, s
 567
 568     elements = pmc_arr
 569     is(elements, 4, "RPA has 4 elements after 4 unshifts")
 570
 571     s_elem = shift pmc_arr
 572     is(s_elem, "abc", "shifted string has correct value")
 573
 574     p_elem = shift pmc_arr
 575     is(p_elem, 456.456, "shifted pmc has correct value")
 576
 577     i_elem = shift pmc_arr
 578     is(i_elem, 123, "shifted int has correct value")
 579
 580     f_elem = shift pmc_arr
 581     is(f_elem, 123.123000, "shifted num has correct value")
 582     elements = pmc_arr
 583     is(elements, 0, "expectedly empty RPA has 0 elements")
 584 .end
 585
 586 .sub shift_empty
 587     .local pmc pmc_arr
 588     pmc_arr = new ['ResizablePMCArray']
 589     $I1 = 0
 590     push_eh handle_i
 591     $I0 = shift pmc_arr
 592     inc $I1
 593 handle_i:
 594     pop_eh
 595     is($I1, 0, 'shift int from empty RPA throws')
 596
 597     push_eh handle_n
 598     $N0 = shift pmc_arr
 599     inc $I1
 600 handle_n:
 601     pop_eh
 602     is($I1, 0, 'shift num from empty RPA throws')
 603
 604     push_eh handle_s
 605     $S0 = shift pmc_arr
 606     inc $I1
 607 handle_s:
 608     pop_eh
 609     is($I1, 0, 'shift string from empty RPA throws')
 610
 611     push_eh handle_p
 612     $P0 = shift pmc_arr
 613     inc $I1
 614 handle_p:
 615     pop_eh
 616     is($I1, 0, 'shift pmc from empty RPA throws')
 617
 618 .end
 619
 620 .sub pop_empty
 621     .local pmc pmc_arr
 622     pmc_arr = new ['ResizablePMCArray']
 623     $I1 = 0
 624     push_eh handle_i
 625     $I0 = pop pmc_arr
 626     inc $I1
 627 handle_i:
 628     pop_eh
 629     is($I1, 0, 'pop int from empty RPA throws')
 630
 631     push_eh handle_n
 632     $N0 = pop pmc_arr
 633     inc $I1
 634 handle_n:
 635     pop_eh
 636     is($I1, 0, 'pop num from empty RPA throws')
 637
 638     push_eh handle_s
 639     $S0 = pop pmc_arr
 640     inc $I1
 641 handle_s:
 642     pop_eh
 643     is($I1, 0, 'pop string from empty RPA throws')
 644
 645     push_eh handle_p
 646     $P0 = pop pmc_arr
 647     inc $I1
 648 handle_p:
 649     pop_eh
 650     is($I1, 0, 'pop pmc from empty RPA throws')
 651
 652 .end
 653
 654 ## an Integer Matrix, as used by befunge as a playing field
 655 .sub multikey_access
 656     .local pmc matrix, row_in, row_out
 657     matrix = new ['ResizablePMCArray']
 658     row_in = new ['ResizableIntegerArray']
 659     push row_in, 42
 660     push matrix, row_in
 661
 662     .local int elem
 663     elem = matrix[0;0]
 664     is(elem, 42, "int in nested ResizableIntegerArray is 42")
 665
 666     matrix[0;1] = 43
 667     elem = matrix[0;1]
 668     is(elem, 43, "int in nested ResizableIntegerArray is 43")
 669 .end
 670
 671
 672 .sub exists_and_defined
 673     .local pmc array
 674     array = new ['ResizablePMCArray']
 675     push array, 'a'
 676     push array, 'b'
 677     push array, 'c'
 678     $P0 = new ['Null']
 679     push array, $P0
 680     push array, 'e'
 681     $P0 = new ['Undef']
 682     push array, $P0
 683     push array, '7'
 684     push array, '-8.8'
 685
 686     .local int flag, index, ex, def
 687
 688     ## bounds checking: lower (0)
 689     ex = exists array[0]
 690     is(ex, 1, "element at idx 0 exists")
 691     def = defined array[0]
 692     is(def, 1, "element at idx 0 is defined")
 693     $P0 = new 'Integer', 0
 694     ex = exists array[$P0]
 695     is(ex, 1, "element at PMC idx 0 exists")
 696
 697     ## bounds checking: upper (7)
 698     ex = exists array[7]
 699     is(ex, 1, "element at idx 7 exists")
 700     def = defined array[7]
 701     is(def, 1, "element at idx 7 is defined")
 702
 703     ## bounds checking: negative lower (-1)
 704     ex = exists array[-1]
 705     is(ex, 1, "element at idx -1 exists")
 706     def = defined array[-1]
 707     is(def, 1, "element at idx -1 is defined")
 708
 709     ## bounds checking: negative upper (-8)
 710     ex = exists array[-8]
 711     is(ex, 1, "element at idx -8 exists")
 712     def = defined array[-8]
 713     is(def, 1, "element at idx -8 is defined")
 714
 715     ## bounds checking: out-of-bounds (8)
 716     ex = exists array[8]
 717     is(ex, 0, "element at idx 8 does not exist")
 718     def = defined array[8]
 719     is(def, 0, "element at idx 8 is not defined")
 720
 721     ## bounds checking: negative out-of-bounds (-9)
 722     ex = exists array[-9]
 723     is(ex, 0, "element at idx -9 does not exist")
 724     def = defined array[-9]
 725     is(def, 0, "element at idx -9 is not defined")
 726
 727     ## null value (3)
 728     ex = exists array[3]
 729     is(ex, 0, "element at idx 3 does not exist")
 730     def = defined array[3]
 731     is(def, 0, "element at idx 3 is not defined")
 732
 733     ## undefined value (5)
 734     ex = exists array[5]
 735     is(ex, 1, "element at idx 5 does not exist")
 736     def = defined array[5]
 737     is(def, 0, "element at idx 5 is not defined")
 738 .end
 739
 740 .sub delete_keyed
 741     .local pmc array
 742     array = new ['ResizablePMCArray']
 743     push array, 'a'
 744     push array, 'b'
 745     push array, 'c'
 746     $P0 = new 'Integer', 1
 747     delete array[$P0]
 748     $S0 = array[1]
 749     is($S0, 'c', 'delete_keyed with PMC key')
 750 .end
 751
 752 .sub get_rep
 753     .local pmc array
 754     array = new ['ResizablePMCArray']
 755     push array, 'a'
 756     push array, 'b'
 757     $S0 = get_repr array
 758     is($S0, '[ a, b ]', 'get_repr')
 759 .end
 760
 761 .sub append_tests
 762
 763     $P1 = new ['ResizablePMCArray']
 764     push $P1, 'a'
 765     push $P1, 'b'
 766     push $P1, 'c'
 767
 768     $P2 = new ['FixedPMCArray']
 769     $P2 = 2
 770     $P0 = new ['Null']
 771     $P2[0] = $P0
 772     $P2[1] = 'e'
 773     $P0 = new ['Undef']
 774
 775     $P3 = new ['ResizablePMCArray']
 776     push $P3, $P0
 777     push $P3, '7'
 778     push $P3, '-8.8'
 779
 780     $P4 = new ['ResizablePMCArray']
 781
 782     $P5 = new ['MultiSub']    # extends ResizablePMCArray
 783     $P99 = new ['Sub']
 784     push $P5, $P99
 785
 786     $P4.'append'( $P4 )
 787     ok( 1, 'parsing' )
 788
 789     $I1 = $P4
 790     is( $I1, 0, 'still size 0' )
 791
 792     $P10 = $P1
 793     $I1 = $P10
 794     $P10.'append'( $P4 )
 795     $I2 = $P10
 796     is( $I1, $I2, 'append empty ResizablePMCArray' )
 797
 798     $S1 = $P10[2]
 799     is( $S1, 'c', 'indexing elements' )
 800
 801     $P10.'append'( $P2 )
 802     is( $P10, 5, 'append FixedPMCArray' )
 803
 804     $S1 = $P10[2]
 805     is( $S1, 'c', 'indexing elements' )
 806
 807     $S1 = $P10[4]
 808     is( $S1, 'e', 'indexing elements' )
 809
 810     $P3.'append'( $P10 )
 811     is( $P3, 8, 'append ResizablePMCArray' )
 812
 813     $S1 = $P3[2]
 814     is( $S1, '-8.8', 'indexing elements' )
 815
 816     $S1 = $P3[4]
 817     is( $S1, 'b', 'indexing elements' )
 818
 819     $P3.'append'( $P5 )
 820     is( $P3, 9, 'append subclass' )
 821
 822     $S1 = $P3[2]
 823     is( $S1, '-8.8', 'indexing elements' )
 824
 825     $P99 = $P3[8]
 826     $I99 = isa $P99, 'Sub'
 827     ok( $I99, 'indexing elements' )
 828 .end
 829
 830
 831 .sub get_array_string
 832     .param pmc p
 833     $S0 = ''
 834     $P3 = iter p
 835 loop:
 836     unless $P3 goto loop_end
 837     $P4 = shift $P3
 838     $S1 = $P4
 839     concat $S0, $S1
 840     goto loop
 841 loop_end:
 842     .return($S0)
 843 .end
 844
 845
 846 .sub splice_tests
 847     .local pmc ar1, ar2
 848     ar1 = new ['ResizablePMCArray']
 849     ar1[0] = 1
 850     ar1[1] = 2
 851     ar1[2] = 3
 852     ar1[3] = 4
 853     ar1[4] = 5
 854
 855     ar2 = new ['ResizablePMCArray']
 856     ar2[0] = 'A'
 857     ar2[1] = 'B'
 858     ar2[2] = 'C'
 859     ar2[3] = 'D'
 860     ar2[4] = 'E'
 861
 862     $P1 = clone ar1
 863     $P2 = clone ar2
 864     splice $P1, $P2, 0, 5
 865     $S0 = get_array_string($P1)
 866     is($S0, "ABCDE", "splice with complete replace")
 867
 868     $P1 = clone ar1
 869     $P2 = clone ar2
 870     splice $P1, $P2, 5, 0
 871     $S0 = get_array_string($P1)
 872     is($S0, "12345ABCDE", "splice, append")
 873
 874     $P1 = clone ar1
 875     $P2 = clone ar2
 876     splice $P1, $P2, 4, 0
 877     $S0 = get_array_string($P1)
 878     is($S0, "1234ABCDE5", "splice, insert before last element")
 879
 880     $P1 = clone ar1
 881     $P2 = clone ar2
 882     splice $P1, $P2, 3, 0
 883     $S0 = get_array_string($P1)
 884     is($S0, "123ABCDE45", "splice, append-in-middle")
 885
 886     $P1 = clone ar1
 887     $P2 = clone ar2
 888     splice $P1, $P2, 0, 2
 889     $S0 = get_array_string($P1)
 890     is($S0, "ABCDE345", "splice, replace at beginning")
 891
 892     $P1 = clone ar1
 893     $P2 = clone ar2
 894     splice $P1, $P2, 2, 2
 895     $S0 = get_array_string($P1)
 896     is($S0, "12ABCDE5", "splice, replace in middle")
 897
 898     $P1 = clone ar1
 899     $P2 = clone ar2
 900     splice $P1, $P2, 3, 2
 901     $S0 = get_array_string($P1)
 902     is($S0, "123ABCDE", "splice, replace at end")
 903
 904     $P1 = clone ar1
 905     $P2 = new ['FixedStringArray']
 906     $P2 = 5
 907     $P2[0] = 'A'
 908     $P2[1] = 'B'
 909     $P2[2] = 'C'
 910     $P2[3] = 'D'
 911     $P2[4] = 'E'
 912     splice $P1, $P2, 3, 2
 913     $S0 = get_array_string($P1)
 914     is($S0, "123ABCDE", "splice, replace with another type")
 915
 916     $P1 = clone ar1
 917     $P2 = new ['ResizablePMCArray']
 918     splice $P1, $P2, 2, 2
 919     $S0 = get_array_string($P1)
 920     is($S0, "125", "splice with empty replacement")
 921
 922     $P1 = clone ar1
 923     $P2 = new ['ResizablePMCArray']
 924     $P2[0] = 'A'
 925     splice $P1, $P2, 2, 1
 926     $S0 = get_array_string($P1)
 927     is($S0, "12A45", "splice with empty replacement")
 928
 929     $P1 = clone ar1
 930     $P2 = clone ar2
 931     splice $P1, $P2, -3, 2
 932     $S0 = get_array_string($P1)
 933     is($S0, "12ABCDE5", "splice with negative offset")
 934
 935     $P1 = clone ar1
 936     $P2 = clone ar2
 937     $I0 = 1
 938     push_eh too_low
 939     splice $P1, $P2, -10, 2
 940     dec $I0
 941     goto too_low_end
 942 too_low:
 943     .get_results($P9)
 944     finalize $P9
 945 too_low_end:
 946     ok($I0, "splice with negative offset too low")
 947 .end
 948
 949
 950 .sub splice_replace1
 951     $P1 = new ['ResizablePMCArray']
 952     $P1 = 3
 953     $P1[0] = '1'
 954     $P1[1] = '2'
 955     $P1[2] = '3'
 956     $P2 = new ['ResizablePMCArray']
 957     $P2 = 1
 958     $P2[0] = 'A'
 959     splice $P1, $P2, 1, 2
 960     $S0 = join "", $P1
 961     is($S0, "1A", "replacement via splice works")
 962 .end
 963
 964
 965 .sub splice_replace2
 966     $P1 = new ['ResizablePMCArray']
 967     $P1 = 3
 968     $P1[0] = '1'
 969     $P1[1] = '2'
 970     $P1[2] = '3'
 971     $P2 = new ['ResizablePMCArray']
 972     $P2 = 1
 973     $P2[0] = 'A'
 974     splice $P1, $P2, 0, 2
 975     $S0 = join "", $P1
 976     is($S0, "A3", "replacement via splice works")
 977 .end
 978
 979
 980 .sub iterate_subclass_of_rpa
 981     .local pmc arr, it
 982     $P0 = subclass 'ResizablePMCArray', 'MyArray'
 983
 984     arr = new ['MyArray']
 985     push arr, 11
 986     push arr, 13
 987     push arr, 15
 988     $I0 = elements arr
 989     is($I0, 3, "RPA subclass has correct element count")
 990
 991     $S1 = ''
 992     it = iter arr
 993 loop:
 994     unless it goto end
 995     $P2 = shift it
 996     $S0 = $P2
 997     concat $S1, $S0
 998     concat $S1, ","
 999     goto loop
1000 end:
1001     is($S1, "11,13,15,", "iterator works on RPA subclass")
1002 .end
1003
1004
1005 .sub method_forms_of_unshift_etc
1006     $P0 = new ['ResizablePMCArray']
1007     $P0.'unshift'(1)
1008     $P0.'push'('two')
1009     $I0 = $P0
1010     is($I0, 2, "method forms of unshift and push add elements to an RPA")
1011     $P1 = $P0.'shift'()
1012     is($P1, 1, "method form of shift works")
1013     $P1 = $P0.'pop'()
1014     is($P1, "two", "method form of pop works")
1015 .end
1016
1017
1018 .sub sort_with_broken_cmp
1019     .local pmc array
1020     array = new ['ResizablePMCArray']
1021     push array, 4
1022     push array, 5
1023     push array, 3
1024     push array, 2
1025     push array, 5
1026     push array, 1
1027
1028     $S0 = join ' ', array
1029     is($S0, "4 5 3 2 5 1", "RPA has expected values")
1030
1031     $P0 = get_global 'cmp_func'
1032     array.'sort'($P0)
1033     ok(1, "sort returns without crashing")
1034 .end
1035
1036 .sub 'cmp_func'
1037     .param pmc a
1038     .param pmc b
1039     $I0 = 1
1040     .return ($I0)
1041 .end
1042
1043 .sub 'addr_tests'
1044     $P0 = new 'ResizablePMCArray'
1045     $I0 = get_addr $P0
1046     $P1 = new 'ResizablePMCArray'
1047     $I1 = get_addr $P1
1048
1049     $I2 = $I0 != 0
1050     ok($I2, 'ResizablePMCArray address is not zero')
1051     $I2 = $I0 != $I1
1052     ok($I2, 'Two empty RPAs do not have same address')
1053
1054     push $P0, 3
1055     $I1 = get_addr $P0
1056     is($I0, $I1, 'Adding element to RPA keeps same addr')
1057 .end
1058
1059 .sub 'equality_tests'
1060     .local pmc array1, array2, array3, array4
1061     array1 = new ['ResizablePMCArray']
1062     array2 = new ['ResizablePMCArray']
1063     array3 = new ['ResizablePMCArray']
1064
1065     array1[0] = "Hello Parrot!"
1066     array1[1] = 1664
1067     array1[2] = 2.718
1068
1069     $P0 = box "Hello Parrot!"
1070     array2[0] = $P0
1071     $P0 = box 1664
1072     array2[1] = $P0
1073     $P0 = box 2.718
1074     array2[2] = $P0
1075
1076     array3[0] = "Goodbye Parrot!"
1077     array3[1] = 1664
1078     array3[2] = 2.718
1079
1080     array4 = clone array1
1081
1082     is(array1, array2, 'Physically disjoint, but equal arrays')
1083     is(array1, array4, 'Clones are equal')
1084     isnt(array1, array3, 'Different arrays')
1085 .end
1086
1087 .sub sort_tailcall
1088     .local pmc array
1089     array = new 'ResizablePMCArray'
1090     push array, 4
1091     push array, 5
1092     push array, 3
1093     push array, 2
1094     push array, 5
1095     push array, 1
1096
1097     .local string unsorted
1098     unsorted = join ' ', array
1099     is(unsorted,"4 5 3 2 5 1", "unsorted array")
1100
1101     ## sort using a non-tailcall function
1102     .const 'Sub' cmp_normal = 'cmp_normal_tailcall'
1103     $P1 = clone array
1104     $P1.'sort'(cmp_normal)
1105     .local string sorted1
1106     sorted1 = join ' ', $P1
1107     is (sorted1, "1 2 3 4 5 5", "sorted array, no tailcall")
1108
1109     ## sort using a tailcall function
1110     .const 'Sub' cmp_tailcall = 'cmp_tailcall_tailcall'
1111     $P1 = clone array
1112     $P1.'sort'(cmp_tailcall)
1113     .local string sorted2
1114     sorted2 = join ' ', $P1
1115     is(sorted2, "1 2 3 4 5 5", "sorted array, with tailcall")
1116 .end
1117
1118 .sub 'cmp_func_tailcall'
1119     .param pmc a
1120     .param pmc b
1121     $I0 = cmp a, b
1122     .return ($I0)
1123 .end
1124
1125 .sub 'cmp_normal_tailcall'
1126     .param pmc a
1127     .param pmc b
1128     $P0 = 'cmp_func_tailcall'(a, b)
1129     .return ($P0)
1130 .end
1131
1132 .sub 'cmp_tailcall_tailcall'
1133     .param pmc a
1134     .param pmc b
1135     .tailcall 'cmp_func_tailcall'(a, b)
1136 .end
1137
1138 # Regression test for TT#835
1139 .sub 'push_to_subclasses_array'
1140     .local pmc cl, array_one
1141     cl = subclass "ResizablePMCArray", "ExampleArray"
1142     array_one = new "ExampleArray"
1143
1144     $I0 = 100000
1145   loop:
1146     array_one.'push'($I0)
1147     dec $I0
1148     if $I0 goto loop
1149
1150     ok(1, "Push to subclassed array works")
1151 .end
1152
1153 # don't forget to change the test plan
1154
1155 # Local Variables:
1156 #   mode: pir
1157 #   fill-column: 100
1158 # End:
1159 # vim: expandtab shiftwidth=4 ft=pir: