resizablepmcarray.t

#!./parrot
# Copyright (C) 2001-2011, Parrot Foundation.

=head1 NAME

t/pmc/resizablepmcarray.t - testing the ResizablePMCArray PMC

=head1 SYNOPSIS

    % prove t/pmc/resizablepmcarray.t

=head1 DESCRIPTION

Tests C<ResizablePMCArray> PMC. Checks size, sets various elements, including
out-of-bounds test. Checks INT and PMC keys.

=cut

.include 'except_types.pasm'

.sub main :main
    .include 'fp_equality.pasm'
    .include 'test_more.pir'

    plan(151)

    init_tests()
    resize_tests()
    negative_array_size()
    set_tests()
    exception_tests()
    set_keyed_get_keyed_tests()
    interface_check()
    inherited_sort_method()
    sort_subclass()
    push_pmc()
    push_int()
    push_string()
    shift_int()
    unshift_pmc()
    get_mro_tests()
    push_and_pop()
    unshift_and_shift()
    shift_empty()
    pop_empty()
    multikey_access()
    exists_and_defined()
    delete_keyed()
    get_rep()
    append_tests()
    splice_tests()
    splice_replace1()
    splice_replace2()
    iterate_subclass_of_rpa()
    method_forms_of_unshift_etc()
    sort_with_broken_cmp()
    equality_tests()
    sort_tailcall()
    push_to_subclasses_array()
    test_assign_from_another()
    test_assign_self()
    test_assign_non_array()
    method_reverse()
.end

.sub init_negative
    .local pmc p
    p = new ['ResizablePMCArray'], -1
.end

.sub init_tests
    .const 'Sub' negative = 'init_negative'
    throws_type(negative, .EXCEPTION_OUT_OF_BOUNDS, 'new with negative size fails')
.end

.sub resize_tests
    .local pmc p
    .local int is_ok, i
    p = new ['ResizablePMCArray']

    i = p
    is_ok = i == 0
    ok(is_ok, "resize test (0)")

    p = 1
    i = p
    is_ok = i == 1
    ok(is_ok, "resize test (1)")

    p = 5
    i = p
    is_ok = i == 5
    ok(is_ok, "resize test (5)")

    p = 9
    i = p
    is_ok = i == 9
    ok(is_ok, "resize test (9)")

    p = 7
    i = p
    is_ok = i == 7
    ok(is_ok, "resize test (7)")
.end


.sub negative_array_size
    .local pmc p
    .local int is_ok, i
    p = new ['ResizablePMCArray']
    push_eh eh
    p = -1
    pop_eh
    ok(0, "exception not caught")
    goto end
eh:
    ok(1, "exception caught")
end:
.end


.sub set_tests
    .local pmc p
    .local int is_ok, i
    .local num n
    .local string s

    p = new ['ResizablePMCArray']
    p = 1

    p[0] = -7
    i = p[0]
    is_ok = i == -7
    ok(is_ok, "INTVAL assignment to first element")

    p[0] = 3.7
    n = p[0]
    is_ok = n == 3.7
    ok(is_ok, "FLOATVAL assignment to first element")

    p[0] = "muwhahaha"
    s = p[0]
    is_ok = s == "muwhahaha"
    ok(is_ok, "STRING assignment to first element")

    p[1] = -7
    i = p[1]
    is_ok = i == -7
    ok(is_ok, "INTVAL assignment to second element")

    p[1] = 3.7
    n = p[1]
    is_ok = n == 3.7
    ok(is_ok, "FLOATVAL assignment to second element")

    p[1] = "muwhahaha"
    s = p[1]
    is_ok = s == "muwhahaha"
    ok(is_ok, "STRING assignment to second element")

    p[10] = -7
    i = p[10]
    is_ok = i == -7
    ok(is_ok, "INTVAL assignment to last element")

    p[10] = 3.7
    n = p[10]
    is_ok = n == 3.7
    ok(is_ok, "FLOATVAL assignment to last element")

    p[10] = "muwhahaha"
    s = p[10]
    is_ok = s == "muwhahaha"
    ok(is_ok, "STRING assignment to last element")
.end


.sub exception_tests
    .local pmc rpa, i

    rpa = new ['ResizablePMCArray']
    rpa = 1
    i = new ['Integer']
    i = 12345

    push_eh eh1
    rpa[10] = i
    pop_eh
    goto no_eh1
eh1:
    ok(0, "unwanted ex thrown for out-of-bounds index")
    goto test2
no_eh1:
    ok(1, "no ex thrown for out-of-bounds index")

test2:
    rpa = 1
    push_eh eh2
    rpa[-10] = i
    pop_eh
    goto no_eh2
eh2:
    ok(1, "ex thrown for negative index")
    goto test3
no_eh2:
    ok(0, "no ex thrown for negative index")

test3:
    rpa = 1
    push_eh eh3
    i = rpa[10]
    pop_eh
    goto no_eh3
eh3:
    ok(0, "unwanted ex thrown for out-of-bounds index")
    goto test4
no_eh3:
    ok(1, "no ex thrown for out-of-bounds index")

test4:
    rpa = 1
    push_eh eh4
    i = rpa[-10]
    pop_eh
    goto no_eh4
eh4:
    ok(1, "ex thrown for negative index")
    goto end
no_eh4:
    ok(0, "no ex thrown for negative index")
end:
.end


.sub set_keyed_get_keyed_tests

    new $P0, ['ResizablePMCArray']
    new $P1, ['Key']

    set $P1, 0
    set $P0[$P1], 25

    set $P1, 1
    set $P0[$P1], 2.5

    set $P1, 2
    set $P0[$P1], "bleep"

    new $P2, ['String']
    set $P2, "Bloop"
    set $P1, 3
    set $P0[$P1], $P2

    set $I0, $P0[0]
    is($I0, 25, "set int via Key PMC, get int via int")

    set $N0, $P0[1]
    .fp_eq($N0, 2.5, OK1)
    ok(0, "set num via Key PMC, get num via int fails")
    goto NOK1
OK1:
    ok(1, "set num via Key PMC, get num via int fails")
NOK1:

    set $S0, $P0[2]
    is($S0, "bleep", "set string via Key PMC, get string via int")

    new $P3, ['Undef']
    set $P3, $P0[3]
    set $S0, $P3
    is($S0, "Bloop", "set PMC via Key PMC, get PMC via PMC")


    new $P0, ['ResizablePMCArray']
    set $P0, 1

    set $P0[25], 125
    set $P0[128], 10.2
    set $P0[513], "cow"
    new $P1, ['Integer']
    set $P1, 123456
    set $P0[1023], $P1

    new $P2, ['Key']
    set $P2, 25
    set $I0, $P0[$P2]
    is($I0, 125, "set int via int, get int via Key PMC")

    set $P2, 128
    set $N0, $P0[$P2]
    .fp_eq($N0, 10.2, OK2)
    ok(0, "set num via int, get num via Key PMC")
    goto NOK2
OK2:
    ok(1, "set num via int, get num via Key PMC")
NOK2:

    set $P2, 513
    set $S0, $P0[$P2]
    is($S0, "cow", "set string via int, get string via Key PMC")

    set $P2, 1023
    set $P3, $P0[$P2]
    set $I1, $P3
    is($I1, 123456, "set int via int, get int via Key PMC")

.end


.sub interface_check
    .local pmc p
    p = new ['ResizablePMCArray']
    .local int b
    does b, p, "scalar"
    is(b, 0 ,"ResizablePMCArray doesn't do scalar")
    does b, p, "array"
    is(b, 1, "ResizablePMCArray does array")
    does b, p, "no_interface"
    is(b, 0, "ResizablePMCArray doesn't do no_interface")
.end


.sub inherited_sort_method
    .local pmc ar
    ar = new ['ResizablePMCArray']

    ar[0] = 10
    ar[1] = 2
    ar[2] = 5
    ar[3] = 9
    ar[4] = 1

    .local pmc cmp_fun
    null cmp_fun
    ar."sort"(cmp_fun)

    .local string sorted
    sorted = ''
    .local pmc it
    iter it, ar
lp:
    unless it goto done
    $P0 = shift it
    $S0 = $P0
    sorted = concat sorted, $S0
    sorted = concat sorted, " "
    goto lp
done:
    is(sorted, "1 2 5 9 10 ", "inherited sort method works")
.end


.sub sort_subclass
    .local pmc subrpa, arr
    subrpa = subclass ['ResizablePMCArray'], 'ssRPA'
    arr = new subrpa
    arr[0] = 'p'
    arr[1] = 'a'
    arr[2] = 'z'
    # Use a comparator that gives a reverse alphabetical order
    # to make sure sort is using it, and not some default from
    # elsewhere.
    .local pmc comparator
    comparator = get_global 'compare_reverse'
    arr.'sort'(comparator)
    .local string s, aux
    s = typeof arr
    s = concat s, ':'
    aux = join '-', arr
    s = concat s, aux
    is(s, 'ssRPA:z-p-a', "sort works in a pir subclass, GH #303")
.end

.sub compare_reverse
    .param string a
    .param string b
    $I0 = cmp b, a
    .return($I0)
.end


.sub push_pmc
    .local pmc pmc_arr, pmc_9999, pmc_10000
    pmc_arr = new ['ResizablePMCArray']
    pmc_9999  = new ['Float']
    pmc_9999  = 10000.10000
    pmc_10000 = new ['Float']
    pmc_10000 = 123.123
    pmc_arr[9999] = pmc_9999
    push pmc_arr, pmc_10000
    .local int elements
    elements = pmc_arr
    is(elements, 10001, "element count is correct")
    .local pmc last
    last = pmc_arr[10000]
    is(last, 123.123, "last element has correct value")
.end


.sub push_int
    .local pmc pmc_arr, pmc_9999
    .local int int_10000
    pmc_arr = new ['ResizablePMCArray']
    pmc_9999  = new ['Float']
    pmc_9999  = 10000.10000
    int_10000 = 123
    pmc_arr[9999] = pmc_9999
    push pmc_arr, int_10000
    .local int elements
    elements = pmc_arr
    is(elements, 10001, "element count is correct")
    .local pmc last
    last = pmc_arr[10000]
    is(last, 123, "last element has correct value")
.end


.sub push_string
    .local pmc pmc_arr, pmc_9999
    .local string string_10000
    pmc_arr = new ['ResizablePMCArray']
    pmc_9999  = new ['Float']
    pmc_9999  = 10000.10000
    string_10000 = '123asdf'
    pmc_arr[9999] = pmc_9999
    push pmc_arr, string_10000
    .local int elements
    elements = pmc_arr
    is(elements, 10001, "element count is correct")
    .local pmc last
    last = pmc_arr[10000]
    is(last, "123asdf", "last element has correct value")
.end


.sub shift_int
    .local pmc pmc_arr, elem
    pmc_arr = new ['ResizablePMCArray']
    push pmc_arr, 4
    push pmc_arr, 3
    push pmc_arr, 2
    push pmc_arr, 1
    push pmc_arr, 0

    .local int elements

    elements = pmc_arr
    is(elements, 5, "element count is correct")

    elem = shift pmc_arr
    is(elem, 4, "correct element unshifted")
    elements = pmc_arr
    is(elements, 4, "correct element count after unshifing")

    elem = shift pmc_arr
    is(elem, 3, "correct element unshifted")
    elements = pmc_arr
    is(elements, 3, "correct element count after unshifing")

    elem = shift pmc_arr
    is(elem, 2, "correct element unshifted")
    elements = pmc_arr
    is(elements, 2, "correct element count after unshifing")

    elem = shift pmc_arr
    is(elem, 1, "correct element unshifted")
    elements = pmc_arr
    is(elements, 1, "correct element count after unshifing")

    elem = shift pmc_arr
    is(elem, 0, "correct element unshifted")
    elements = pmc_arr
    is(elements, 0, "correct element count after unshifing")

.end

.sub unshift_pmc
    new $P0, ['ResizablePMCArray']
    new $P1, ['Integer']
    set $P1, 1
    new $P2, ['Integer']
    set $P2, 2
    new $P3, ['Integer']
    set $P3, 3
    unshift $P0, $P1
    unshift $P0, $P2
    unshift $P0, $P3
    elements $I0, $P0
    is($I0, 3, "element count is correct")
    set $P3, $P0[0]
    is($P3, 3, "element 0 has correct value")
    set $P3, $P0[1]
    is($P3, 2, "element 1 has correct value")
    set $P3, $P0[2]
    is($P3, 1, "element 2 has correct value")
.end


.sub get_mro_tests
    new $P0, ['ResizablePMCArray']
    $P1 = inspect $P0, 'mro'
    ok(1, "get_mro didn't explode")
    elements $I1, $P1
    null $I0
    $S1 = ''
loop:
    set $P2, $P1[$I0]
    typeof $S0, $P2
    $S1 = concat $S1, $S0
    $S1 = concat $S1, ","
    inc $I0
    lt $I0, $I1, loop

    is($S1, "ResizablePMCArray,FixedPMCArray,", "ResizablePMCArrays have the right MRO")
.end


.sub push_and_pop
    .local num f, f_elem
    .local int i, i_elem, elements
    .local pmc p, p_elem, pmc_arr
    .local string s, s_elem

    f = 123.123
    i = 123
    p = new ['Float']
    p = 456.456
    s = "abc"

    pmc_arr = new ['ResizablePMCArray']

    elements = pmc_arr
    is(elements, 0, "element count of empty ResizablePMCArray is 0")

    push pmc_arr, s
    push pmc_arr, p
    push pmc_arr, i
    push pmc_arr, f

    elements = pmc_arr
    is(elements, 4, "element count after several push operations is correct")

    f_elem = pop pmc_arr
    is(f_elem, 123.123000, "shifted float is correct")

    i_elem = pop pmc_arr
    is(i_elem, 123, "shifted int is correct")

    p_elem = pop pmc_arr
    is(p_elem, 456.456, "shifted PMC is correct")

    s_elem = pop pmc_arr
    is(s_elem, "abc", "shifted string is correct")
    elements = pmc_arr
    is(elements, 0, "element count after several shift operations is correct")

.end


.sub unshift_and_shift
    .local num f, f_elem
    .local int i, i_elem, elements
    .local pmc p, p_elem, pmc_arr
    .local string s, s_elem

    f = 123.123
    i = 123
    p = new ['Float']
    p = 456.456
    s = "abc"

    pmc_arr = new ['ResizablePMCArray']

    elements = pmc_arr
    is(elements, 0, "empty RPA has 0 elements")

    unshift pmc_arr, f
    unshift pmc_arr, i
    unshift pmc_arr, p
    unshift pmc_arr, s

    elements = pmc_arr
    is(elements, 4, "RPA has 4 elements after 4 unshifts")

    s_elem = shift pmc_arr
    is(s_elem, "abc", "shifted string has correct value")

    p_elem = shift pmc_arr
    is(p_elem, 456.456, "shifted pmc has correct value")

    i_elem = shift pmc_arr
    is(i_elem, 123, "shifted int has correct value")

    f_elem = shift pmc_arr
    is(f_elem, 123.123000, "shifted num has correct value")
    elements = pmc_arr
    is(elements, 0, "expectedly empty RPA has 0 elements")
.end

.sub shift_empty
    .local pmc pmc_arr
    pmc_arr = new ['ResizablePMCArray']
    $I1 = 0
    push_eh handle_i
    $I0 = shift pmc_arr
    inc $I1
handle_i:
    pop_eh
    is($I1, 0, 'shift int from empty RPA throws')

    push_eh handle_n
    $N0 = shift pmc_arr
    inc $I1
handle_n:
    pop_eh
    is($I1, 0, 'shift num from empty RPA throws')

    push_eh handle_s
    $S0 = shift pmc_arr
    inc $I1
handle_s:
    pop_eh
    is($I1, 0, 'shift string from empty RPA throws')

    push_eh handle_p
    $P0 = shift pmc_arr
    inc $I1
handle_p:
    pop_eh
    is($I1, 0, 'shift pmc from empty RPA throws')

.end

.sub pop_empty
    .local pmc pmc_arr
    pmc_arr = new ['ResizablePMCArray']
    $I1 = 0
    push_eh handle_i
    $I0 = pop pmc_arr
    inc $I1
handle_i:
    pop_eh
    is($I1, 0, 'pop int from empty RPA throws')

    push_eh handle_n
    $N0 = pop pmc_arr
    inc $I1
handle_n:
    pop_eh
    is($I1, 0, 'pop num from empty RPA throws')

    push_eh handle_s
    $S0 = pop pmc_arr
    inc $I1
handle_s:
    pop_eh
    is($I1, 0, 'pop string from empty RPA throws')

    push_eh handle_p
    $P0 = pop pmc_arr
    inc $I1
handle_p:
    pop_eh
    is($I1, 0, 'pop pmc from empty RPA throws')

.end

## an Integer Matrix, as used by befunge as a playing field
.sub multikey_access
    .local pmc matrix, row_in, row_out
    matrix = new ['ResizablePMCArray']
    row_in = new ['ResizableIntegerArray']
    push row_in, 42
    push matrix, row_in

    .local int elem
    elem = matrix[0;0]
    is(elem, 42, "int in nested ResizableIntegerArray is 42")

    matrix[0;1] = 43
    elem = matrix[0;1]
    is(elem, 43, "int in nested ResizableIntegerArray is 43")
.end


.sub exists_and_defined
    .local pmc array
    array = new ['ResizablePMCArray']
    push array, 'a'
    push array, 'b'
    push array, 'c'
    $P0 = new ['Null']
    push array, $P0
    push array, 'e'
    $P0 = new ['Undef']
    push array, $P0
    push array, '7'
    push array, '-8.8'

    .local int flag, index, ex, def

    ## bounds checking: lower (0)
    ex = exists array[0]
    is(ex, 1, "element at idx 0 exists")
    def = defined array[0]
    is(def, 1, "element at idx 0 is defined")
    $P0 = new 'Integer', 0
    ex = exists array[$P0]
    is(ex, 1, "element at PMC idx 0 exists")

    ## bounds checking: upper (7)
    ex = exists array[7]
    is(ex, 1, "element at idx 7 exists")
    def = defined array[7]
    is(def, 1, "element at idx 7 is defined")

    ## bounds checking: negative lower (-1)
    ex = exists array[-1]
    is(ex, 1, "element at idx -1 exists")
    def = defined array[-1]
    is(def, 1, "element at idx -1 is defined")

    ## bounds checking: negative upper (-8)
    ex = exists array[-8]
    is(ex, 1, "element at idx -8 exists")
    def = defined array[-8]
    is(def, 1, "element at idx -8 is defined")

    ## bounds checking: out-of-bounds (8)
    ex = exists array[8]
    is(ex, 0, "element at idx 8 does not exist")
    def = defined array[8]
    is(def, 0, "element at idx 8 is not defined")

    ## bounds checking: negative out-of-bounds (-9)
    ex = exists array[-9]
    is(ex, 0, "element at idx -9 does not exist")
    def = defined array[-9]
    is(def, 0, "element at idx -9 is not defined")

    ## null value (3)
    ex = exists array[3]
    is(ex, 0, "element at idx 3 does not exist")
    def = defined array[3]
    is(def, 0, "element at idx 3 is not defined")

    ## undefined value (5)
    ex = exists array[5]
    is(ex, 1, "element at idx 5 does not exist")
    def = defined array[5]
    is(def, 0, "element at idx 5 is not defined")
.end

.sub delete_keyed
    .local pmc array
    array = new ['ResizablePMCArray']
    push array, 'a'
    push array, 'b'
    push array, 'c'
    $P0 = new 'Integer', 1
    delete array[$P0]
    $S0 = array[1]
    is($S0, 'c', 'delete_keyed with PMC key')
.end

.sub get_rep
    .local pmc array
    array = new ['ResizablePMCArray']
    push array, 'a'
    push array, 'b'
    $S0 = get_repr array
    is($S0, '[ a, b ]', 'get_repr')
.end

.sub append_tests

    $P1 = new ['ResizablePMCArray']
    push $P1, 'a'
    push $P1, 'b'
    push $P1, 'c'

    $P2 = new ['FixedPMCArray']
    $P2 = 2
    $P0 = new ['Null']
    $P2[0] = $P0
    $P2[1] = 'e'
    $P0 = new ['Undef']

    $P3 = new ['ResizablePMCArray']
    push $P3, $P0
    push $P3, '7'
    push $P3, '-8.8'

    $P4 = new ['ResizablePMCArray']

    $P5 = new ['MultiSub']    # extends ResizablePMCArray
    $P99 = new ['Sub']
    push $P5, $P99

    $P4.'append'( $P4 )
    ok( 1, 'parsing' )

    $I1 = $P4
    is( $I1, 0, 'still size 0' )

    $P10 = $P1
    $I1 = $P10
    $P10.'append'( $P4 )
    $I2 = $P10
    is( $I1, $I2, 'append empty ResizablePMCArray' )

    $S1 = $P10[2]
    is( $S1, 'c', 'indexing elements' )

    $P10.'append'( $P2 )
    is( $P10, 5, 'append FixedPMCArray' )

    $S1 = $P10[2]
    is( $S1, 'c', 'indexing elements' )

    $S1 = $P10[4]
    is( $S1, 'e', 'indexing elements' )

    $P3.'append'( $P10 )
    is( $P3, 8, 'append ResizablePMCArray' )

    $S1 = $P3[2]
    is( $S1, '-8.8', 'indexing elements' )

    $S1 = $P3[4]
    is( $S1, 'b', 'indexing elements' )

    $P3.'append'( $P5 )
    is( $P3, 9, 'append subclass' )

    $S1 = $P3[2]
    is( $S1, '-8.8', 'indexing elements' )

    $P99 = $P3[8]
    $I99 = isa $P99, 'Sub'
    ok( $I99, 'indexing elements' )
.end


.sub get_array_string
    .param pmc p
    $S0 = ''
    $P3 = iter p
loop:
    unless $P3 goto loop_end
    $P4 = shift $P3
    $S1 = $P4
    $S0 = concat $S0, $S1
    goto loop
loop_end:
    .return($S0)
.end


.sub splice_tests
    .local pmc ar1, ar2
    ar1 = new ['ResizablePMCArray']
    ar1[0] = 1
    ar1[1] = 2
    ar1[2] = 3
    ar1[3] = 4
    ar1[4] = 5

    ar2 = new ['ResizablePMCArray']
    ar2[0] = 'A'
    ar2[1] = 'B'
    ar2[2] = 'C'
    ar2[3] = 'D'
    ar2[4] = 'E'

    $P1 = clone ar1
    $P2 = clone ar2
    splice $P1, $P2, 0, 5
    $S0 = get_array_string($P1)
    is($S0, "ABCDE", "splice with complete replace")

    $P1 = clone ar1
    $P2 = clone ar2
    splice $P1, $P2, 5, 0
    $S0 = get_array_string($P1)
    is($S0, "12345ABCDE", "splice, append")

    $P1 = clone ar1
    $P2 = clone ar2
    splice $P1, $P2, 4, 0
    $S0 = get_array_string($P1)
    is($S0, "1234ABCDE5", "splice, insert before last element")

    $P1 = clone ar1
    $P2 = clone ar2
    splice $P1, $P2, 3, 0
    $S0 = get_array_string($P1)
    is($S0, "123ABCDE45", "splice, append-in-middle")

    $P1 = clone ar1
    $P2 = clone ar2
    splice $P1, $P2, 0, 2
    $S0 = get_array_string($P1)
    is($S0, "ABCDE345", "splice, replace at beginning")

    $P1 = clone ar1
    $P2 = clone ar2
    splice $P1, $P2, 2, 2
    $S0 = get_array_string($P1)
    is($S0, "12ABCDE5", "splice, replace in middle")

    $P1 = clone ar1
    $P2 = clone ar2
    splice $P1, $P2, 3, 2
    $S0 = get_array_string($P1)
    is($S0, "123ABCDE", "splice, replace at end")

    $P1 = clone ar1
    $P2 = new ['FixedStringArray']
    $P2 = 5
    $P2[0] = 'A'
    $P2[1] = 'B'
    $P2[2] = 'C'
    $P2[3] = 'D'
    $P2[4] = 'E'
    splice $P1, $P2, 3, 2
    $S0 = get_array_string($P1)
    is($S0, "123ABCDE", "splice, replace with another type")

    $P1 = clone ar1
    $P2 = new ['ResizablePMCArray']
    splice $P1, $P2, 2, 2
    $S0 = get_array_string($P1)
    is($S0, "125", "splice with empty replacement")

    $P1 = clone ar1
    $P2 = new ['ResizablePMCArray']
    $P2[0] = 'A'
    splice $P1, $P2, 2, 1
    $S0 = get_array_string($P1)
    is($S0, "12A45", "splice with empty replacement")

    $P1 = clone ar1
    $P2 = clone ar2
    splice $P1, $P2, -3, 2
    $S0 = get_array_string($P1)
    is($S0, "12ABCDE5", "splice with negative offset")

    $P1 = clone ar1
    $P2 = clone ar2
    $I0 = 1
    push_eh too_low
    splice $P1, $P2, -10, 2
    dec $I0
    goto too_low_end
too_low:
    .get_results($P9)
    finalize $P9
too_low_end:
    ok($I0, "splice with negative offset too low")
.end


.sub splice_replace1
    $P1 = new ['ResizablePMCArray']
    $P1 = 3
    $P1[0] = '1'
    $P1[1] = '2'
    $P1[2] = '3'
    $P2 = new ['ResizablePMCArray']
    $P2 = 1
    $P2[0] = 'A'
    splice $P1, $P2, 1, 2
    $S0 = join "", $P1
    is($S0, "1A", "replacement via splice works")
.end


.sub splice_replace2
    $P1 = new ['ResizablePMCArray']
    $P1 = 3
    $P1[0] = '1'
    $P1[1] = '2'
    $P1[2] = '3'
    $P2 = new ['ResizablePMCArray']
    $P2 = 1
    $P2[0] = 'A'
    splice $P1, $P2, 0, 2
    $S0 = join "", $P1
    is($S0, "A3", "replacement via splice works")
.end


.sub iterate_subclass_of_rpa
    .local pmc arr, it
    $P0 = subclass 'ResizablePMCArray', 'MyArray'

    arr = new ['MyArray']
    push arr, 11
    push arr, 13
    push arr, 15
    $I0 = elements arr
    is($I0, 3, "RPA subclass has correct element count")

    $S1 = ''
    it = iter arr
loop:
    unless it goto end
    $P2 = shift it
    $S0 = $P2
    $S1 = concat $S1, $S0
    $S1 = concat $S1, ","
    goto loop
end:
    is($S1, "11,13,15,", "iterator works on RPA subclass")
.end


.sub method_forms_of_unshift_etc
    $P0 = new ['ResizablePMCArray']
    $P0.'unshift'(1)
    $P0.'push'('two')
    $I0 = $P0
    is($I0, 2, "method forms of unshift and push add elements to an RPA")
    $P1 = $P0.'shift'()
    is($P1, 1, "method form of shift works")
    $P1 = $P0.'pop'()
    is($P1, "two", "method form of pop works")
.end


.sub sort_with_broken_cmp
    .local pmc array
    array = new ['ResizablePMCArray']
    push array, 4
    push array, 5
    push array, 3
    push array, 2
    push array, 5
    push array, 1

    $S0 = join ' ', array
    is($S0, "4 5 3 2 5 1", "RPA has expected values")

    $P0 = get_global 'cmp_func'
    array.'sort'($P0)
    ok(1, "sort returns without crashing")
.end

.sub 'cmp_func'
    .param pmc a
    .param pmc b
    $I0 = 1
    .return ($I0)
.end

.sub 'equality_tests'
    .local pmc array1, array2, array3, array4
    array1 = new ['ResizablePMCArray']
    array2 = new ['ResizablePMCArray']
    array3 = new ['ResizablePMCArray']

    array1[0] = "Hello Parrot!"
    array1[1] = 1664
    array1[2] = 2.718

    $P0 = box "Hello Parrot!"
    array2[0] = $P0
    $P0 = box 1664
    array2[1] = $P0
    $P0 = box 2.718
    array2[2] = $P0

    array3[0] = "Goodbye Parrot!"
    array3[1] = 1664
    array3[2] = 2.718

    array4 = clone array1

    is(array1, array2, 'Physically disjoint, but equal arrays')
    is(array1, array4, 'Clones are equal')
    isnt(array1, array3, 'Different arrays')
.end

.sub sort_tailcall
    .local pmc array
    array = new 'ResizablePMCArray'
    push array, 4
    push array, 5
    push array, 3
    push array, 2
    push array, 5
    push array, 1

    .local string unsorted
    unsorted = join ' ', array
    is(unsorted,"4 5 3 2 5 1", "unsorted array")

    ## sort using a non-tailcall function
    .const 'Sub' cmp_normal = 'cmp_normal_tailcall'
    $P1 = clone array
    $P1.'sort'(cmp_normal)
    .local string sorted1
    sorted1 = join ' ', $P1
    is (sorted1, "1 2 3 4 5 5", "sorted array, no tailcall")

    ## sort using a tailcall function
    .const 'Sub' cmp_tailcall = 'cmp_tailcall_tailcall'
    $P1 = clone array
    $P1.'sort'(cmp_tailcall)
    .local string sorted2
    sorted2 = join ' ', $P1
    is(sorted2, "1 2 3 4 5 5", "sorted array, with tailcall")
.end

.sub 'cmp_func_tailcall'
    .param pmc a
    .param pmc b
    $I0 = cmp a, b
    .return ($I0)
.end

.sub 'cmp_normal_tailcall'
    .param pmc a
    .param pmc b
    $P0 = 'cmp_func_tailcall'(a, b)
    .return ($P0)
.end

.sub 'cmp_tailcall_tailcall'
    .param pmc a
    .param pmc b
    .tailcall 'cmp_func_tailcall'(a, b)
.end

# Regression test for TT#835
.sub 'push_to_subclasses_array'
    .local pmc cl, array_one
    cl = subclass "ResizablePMCArray", "ExampleArray"
    array_one = new "ExampleArray"

    $I0 = 100000
  loop:
    array_one.'push'($I0)
    dec $I0
    if $I0 goto loop

    ok(1, "Push to subclassed array works")
.end

.sub test_assign_non_array
    throws_substring(<<'CODE', "Can't set self from this type",'assign from non-array')
    .sub main :main
        .local pmc arr, other
        .local int n
        arr = new ['ResizablePMCArray']
        other = new ['Integer']
        assign arr, other
    .end
CODE
.end

.sub test_assign_self
    .local pmc arr
    arr = new ['ResizablePMCArray']
    assign arr, arr
    ok(1, 'Can assign ResizablePMCArray to itself')
.end

.sub test_assign_from_another
    .local pmc arr1, arr2
    .local int n
    arr1 = new ['ResizablePMCArray']
    arr1 = 32
    arr2 = new ['ResizablePMCArray']
    arr2 = 15
    assign arr1, arr2
    n = arr1
    is(n,15,'assigning to ResizablePMCArray from another ResizablePMCArray')
.end

.sub method_reverse
    .local pmc array
    array = new ['ResizablePMCArray']
    array."reverse"()
    $I0 = elements array
    is($I0, 0, "method_reverse - reverse of empty array")
    push array, 3
    array."reverse"()
    $S0 = array[0]
    is($S0, "3", "method_reverse - reverse of array with one element")
    push array, "1"
    array."reverse"()
    array."reverse"()
    array."reverse"()
    $S0 = array[0]
    is($S0, "1", "method_reverse - reverse of array with two elements")
    $S0 = array[1]
    is($S0, "3", "method_reverse - reverse of array with two elements second element")
    push array, 4
    array."reverse"()
    push array, 5
    array."reverse"()
    $S0 = join "", array
    is($S0, "5134", "method_reverse - four elements")
    array."reverse"()
    $S0 = join "", array
    is($S0, "4315", "method_reverse - four elements second reverse")
    push array, 6
    array."reverse"()
    $S0 = join "", array
    is($S0, "65134", "method_reverse - five elements")
    array."reverse"()
    $S0 = join "", array
    is($S0, "43156", "method_reverse - five elements second reverse")
.end


# don't forget to change the test plan

# Local Variables:
#   mode: pir
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir: