#! perl
# Copyright (C) 2001-2005, The Perl Foundation.
# $Id: /mirror/trunk/t/pmc/intlist.t 35422 2009-01-11T07:23:36.493974Z cotto  $

use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
use Parrot::Test tests => 9;

=head1 NAME

t/pmc/intlist.t - Integer Array

=head1 SYNOPSIS

    % prove t/pmc/intlist.t

=head1 DESCRIPTION

Tests the C<IntList> PMC. For sparse array tests of C<IntList>, please see
F<t/dynpmc/sparse_perlarray.t>.

=cut

pasm_output_is( <<'CODE', <<'OUTPUT', "creation" );
        new P0, 'IntList'
        set I0, P0
        print "Created IntList with "
        print I0
        print " elements to start with.\n"
        end
CODE
Created IntList with 0 elements to start with.
OUTPUT

# This test just runs way too slowly with GC_DEBUG turned on, so lets
# turn it off for make test runs.
pasm_output_is( <<'CODE', <<'OUTPUT', "aerobics" );
        new P0, 'IntList'
        set I10, 10000

        set I1, 0
        set I0, 0
buildup:
        ge I0, I10, postBuildUp
        push P0, I1
        add I1, 1    # Push P0, I1++
        push P0, I1
        add I1, 1    # Push P0, I1++
        push P0, I1
        add I1, 1    # Push P0, I1++

        pop I2, P0
        mul I3, I0, 3
        add I3, 2
        ne I2, I3, errFirstPop  # fail if pop != I0 * 3 + 2

        pop I2, P0
        mul I3, I0, 3
        add I3, 1
        ne I2, I3, errSecondPop  # fail if pop != I0 * 3 + 1

        set I2, P0
        add I3, I0, 1
        ne I2, I3, errBuildLen   # fail if length != I0 + 1

        add I0, 1
        branch buildup
postBuildUp:

        set I0, 0
checkBuildUpLeft:
        ge I0, I10, postCheckBuildUpLeft
        set I2, P0[I0]
        mul I3, I0, 3
        ne I2, I3, errLeftGet
        add I0, 1
        branch checkBuildUpLeft
postCheckBuildUpLeft:

        mul I0, I10, -1
checkBuildUpRight:
        ge I0, 0, postCheckBuildUpRight
        set I2, P0[I0]
        add I3, I0, I10
        mul I3, 3
        ne I2, I3, errRightGet
        add I0, 1
        branch checkBuildUpRight
postCheckBuildUpRight:

        mul I0, I10, 30
        push P0, I0

        set I0, I10
tearDown:
        le I0, 0, postTearDown
        pop I2, P0
        mul I3, I0, 30
        ne I2, I3, errTearCap

        pop I2, P0
        sub I3, I0, 1
        mul I3, 3
        ne I2, I3, errTearInner

        mul I3, 10
        push P0, I3

        set I2, P0
        ne I2, I0, errTearLength

        sub I0, 1
        branch tearDown
postTearDown:

        pop I2, P0
        ne I2, 0, errLast

        print "I need a shower.\n"
        end
errFirstPop:
        print "FAILED: first pop\n"
        bsr info
        end
errSecondPop:
        print "FAILED: second pop\n"
        bsr info
        end
errBuildLen:
        print "FAILED: buildup length\n"
        bsr info
        end
errLeftGet:
        print "FAILED: left get\n"
        bsr info
        end
errRightGet:
        print "FAILED: right get\n"
        bsr info
        end
errTearCap:
        print "FAILED: tear down cap\n"
        bsr info
        end
errTearInner:
        print "FAILED: tear down inner\n"
        bsr info
        end
errTearLength:
        print "FAILED: tear down length\n"
        bsr info
        end
errLast:
        print "FAILED: last element (zero)\n"
        set I3, 0
        bsr info
        end
info:
        print "Found: "
        print I2
        print "\nWanted: "
        print I3
        print "\n"
        ret
CODE
I need a shower.
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "out of bounds" );
    #shouldn't cause a segfault
    new P0, 'IntList'
    set P0, 1
    set I0, P0[25]
    set S0, "didn't segfault\n"
    print S0
    end
CODE
didn't segfault
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "direct access 2" );
    new P0, 'IntList'
    set I10, 1100000
    set I0, 1
lp1:
    add I1, I0, 5
    set P0[I0], I1
    add I3, I1, I0
    push P0, I3
    shl I0, I0, 1
    inc I0
    le I0, I10, lp1

    set I0, 1
lp2:
    add I1, I0, 5
    # check at I0
    set I2, P0[I0]
    ne I2, I1, err
    add I4, I0, 1
    # and pushed value at I0+1
    set I4, P0[I4]
    add I3, I1, I0
    ne I3, I4, err

    shl I0, I0, 1
    inc I0
    le I0, I10, lp2
    print "ok\n"
    end
err:
    print "not ok "
    print I0
    print " "
    print I1
    print " "
    print I2
    print " "
    print I3
    print " "
    print I4
    print " "
    print I5
    print " "
    print I6
    print " "
    print I7
    print "\n"

    end
CODE
ok
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "sparse access" );
    new P0, 'IntList'
    set I10, 110000
    set I0, 1
lp1:
    add I1, I0, 5
    set P0[I0], I1
    add I3, I1, I0
    push P0, I3
    shl I0, I0, 1
    inc I0
    le I0, I10, lp1

    set I0, 1
lp2:
    add I1, I0, 5
    # check at I0
    set I2, P0[I0]
    ne I2, I1, err
    add I4, I0, 1
    # and pushed value at I0+1
    set I4, P0[I4]
    add I3, I1, I0
    ne I3, I4, err

    shl I0, I0, 1
    inc I0
    le I0, I10, lp2
    print "ok 1\n"

    # now repeat and fill some holes

    set I0, 777
lp3:
    add I1, I0, 5
    set P0[I0], I1
    add I0, I0, 666
    le I0, I10, lp3

    set I0, 777
lp4:
    add I1, I0, 5
    # check at I0
    set I2, P0[I0]
    ne I2, I1, err

    add I0, I0, 666
    le I0, I10, lp4
    print "ok 2\n"
    end
err:
    print "not ok "
    print I0
    print " "
    print I1
    print " "
    print I2
    print " "
    print I3
    print " "
    print I4
    print "\n"

    end
CODE
ok 1
ok 2
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "pop into sparse" );
    new P0, 'IntList'
    set I10, 100
    set I0, 0
    # push some values at start
lp1:
    push P0, I0
    inc I0
    lt I0, I10, lp1

    # create sparse
    set I0, 100000
    set I1, 1000
    set P0[I0], I1
    inc I1
lp2:
    # push some values after hole
    push P0, I1
    inc I1
    le I1, 1100, lp2
    dec I1

    set I3, P0
lp3:
    set I4, P0
    ne I3, I4, err1
    pop I2, P0
    dec I3
    ne I2, I1, err2
    gt I3, I0, cont1
    lt I3, I10, cont1
    set I1, 0

    gt I3, I10, lp3
    set I1, I10

cont1:
    dec I1
    eq I1, 0, ok
    branch lp3
ok:
    print "ok\n"
    end
err1:   set S0, "len"
    branch err
err2:
    set S0, "val"
err:
    print "nok "
    print S0
    print " "
    print I0
    print " "
    print I1
    print " "
    print I2
    print " "
    print I3
    print " "
    print I4
    end
CODE
ok
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "clone" );
    new P0, 'IntList'
    set P0[0], 100
    set P0[5000], 200
    clone P1, P0

    set I0, P0[5000]
    eq I0, 200, ok_1
    print "nok 1 "
ok_1:
    pop I0, P0
    eq I0, 200, ok_2
    print "nok 2 "
ok_2:
    set I0, P0
    eq I0, 5000, ok_3
    print "nok 3 "
ok_3:
    set I0, P1[5000]
    eq I0, 200, ok_4
    print "nok 4 "
ok_4:
    pop I0, P1
    eq I0, 200, ok_5
    print "nok 5 "
ok_5:
    set I0, P1
    eq I0, 5000, ok_6
    print "nok 6 "
    end
ok_6:
    print "ok\n"
    end
CODE
ok
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "access via a PMC key" );
        new P0, 'IntList'
        new P1, 'Key'
        set I0, 0

L1:     set P1, I0
        mul I1, I0, 2
        set P0[P1], I1
        inc I0
        lt I0, 1025, L1

        set I2, 0
L2:     set I3, P0[I2]
        mul I4, I2, 2
        ne I3, I4, BAD1
        inc I2
        lt I2, 1025, L2
        print "ok 1\n"

GET:
        new P2, 'IntList'
        new P3, 'Key'

        set I0, 0
L3:     set P2[I0], I0
        inc I0
        lt I0, 260, L3

        set I1, 0
L4:     set P3, I1
        set I2, P2[P3]
        ne I1, I2, BAD2
        inc I1
        lt I1, 260, L4
        print "ok 2\n"
        end

BAD1:   print "not ok 1\n"
        branch GET
BAD2:   print "not ok 2\n"
        end
CODE
ok 1
ok 2
OUTPUT

pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" );

.sub _main
    .local pmc pmc1
    pmc1 = new ['IntList']
    .local int bool1
    does bool1, pmc1, "scalar"
    print bool1
    print "\n"
    does bool1, pmc1, "array"
    print bool1
    print "\n"
    does bool1, pmc1, "no_interface"
    print bool1
    print "\n"
    end
.end
CODE
0
1
0
OUTPUT

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
