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" );