The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

our @DEBUG;
use Test::More tests => 28;

BEGIN {

    #@DEBUG=qw(DEBUG 1);
    use_ok( 'Tie::Array::PackedC', qw( packed_array packed_array_string ) );
    use_ok( 'Tie::Array::PackedC', qw( Double d ), @DEBUG );
}

my $tie = packed_array( 1 .. 20 );
my $obj = tied(@$tie);
isa_ok( $tie, 'ARRAY', 'packed_array returned an object that' );
isa_ok( $obj, 'Tie::Array::PackedC', 'the tied object' );
is( "@$tie",    "@{[1..20]}", "All" );
is( $tie->[0],  1,            'Zero index' );
is( $tie->[3],  4,            'Intermediate index' );
is( $tie->[19], 20,           'Last index' );
is( $tie->[-1], 20,           'Last index (-1)' );
is( $tie->[20], undef,        'Out of bounds' );

push @$tie, 10;

is( $tie->[20], 10, 'Pushed' );
is( pop @$tie,  10, 'Popped' );
is( @$tie,      20, 'Count' );
is( $#$tie,     19, 'Count 2' );

@DEBUG and $obj->hex_dump;

my $float = Tie::Array::PackedC::Double::packed_array( 1 .. 20 );
isa_ok( tied(@$float), 'Tie::Array::PackedC::Double', '$float' );
is( "@$float", "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20", "All (Double)" );
$float->[0] = 1.414;
is( sprintf( "%0.3f", $float->[0] ), sprintf( "%0.3f", 1.414 ), 'Float check' );
ok( exists( $float->[0] ), '$float->[0] exists' );
ok( !exists( $float->[20] ), '$float->[1] not exists' );
is( delete( $float->[1] ), 2, 'Delete returns correctly' );
is( $float->[1], 0, 'Deleted record is 0' );

my ( $s, @a ) = pack "l!*", 1 .. 5;
tie @a, 'Tie::Array::PackedC', $s, reverse 1 .. 4;
is( "@a", "4 3 2 1 5", "Doc check 1 - Initialization overlap" );
$a[5] = 10;
is ($a[5],10, "Store into \$array[\@array] works");
isnt( $s, tied(@a)->string, "Doc check 2 - Real versus method string access" );

$a[7] = 11;
is ($a[7],11, "Store past end of \@array works ");
is ($a[6],0, "Store past end of \@array works (intermediate goes to 0) ");
my $l1=length(${tied(@a)});
tied(@a)->trim;
my $l2=length(${tied(@a)});
isnt($l1,$l2,"Trim trimmed");
is( "@a", "4 3 2 1 5 10 0 11", "Trim didn't corrupt" );