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