The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -s

use strict;
use warnings;
use Test::More tests => 338;

use constant N    =>  5;
use constant KEYS =>  9;

BEGIN {
    if (-d 't') {
        chdir 't' or die "Failed to chdir: $!\n";
    }

    unshift @INC => ".";

    unless (grep {m!"blib/lib"!} @INC) {
        push @INC => grep {-d} "blib/lib", "../blib/lib"
    }

    use_ok ('Array');
}

ok (defined $Lexical::Attributes::VERSION &&
            $Lexical::Attributes::VERSION > 0, '$VERSION');


#
# Check whether methods were created (or not).
#

{
    no strict 'refs';
    for my $k (qw /default pr priv/) {
        ok (!defined &{"Array::a_${k}"},     "!defined &Array::a_${k}");
        ok (!defined &{"Array::set_a_${k}"}, "!defined &Array::set_a_${k}");
    }
    for my $k (qw /ro/) {
        ok ( defined &{"Array::a_${k}"},     " defined &Array::a_${k}");
        ok (!defined &{"Array::set_a_${k}"}, "!defined &Array::set_a_${k}");
    }
    for my $k (qw /rw/) {
        ok ( defined &{"Array::a_${k}"},     " defined &Array::a_${k}");
        ok ( defined &{"Array::set_a_${k}"}, " defined &Array::set_a_${k}");
    }
}


ok ( defined &Array::array,       " defined &Array::array");
ok ( defined &Array::set_array,   " defined &Array::set_array");
ok (!defined &Array::unused,      "!defined &Array::unused");
ok (!defined &Array::set_unused,  "!defined &Array::set_unused");


#
# Can we create objects?
#
my @obj;
for (0 .. N - 1) {
    $obj [$_] = Array -> new;
    isa_ok ($obj [$_], "Array");
}

for my $i (0 .. N - 2) {
    for my $j ($i + 1 .. N - 1) {
        ok $obj [$i] ne $obj [$j], "Different objects ($i, $j)";
    }
}

#
# Data to use
#

my @data;
for my $i (0 .. N - 1) {
    $data [$i] {reference} = [map {"val- ref-$_"} 0 .. $i * 2];
    $data [$i] {index}     = [map {"val-ind1-$_"} 0 .. $i * 2];
    $data [$i] {index2}    = [map {"val-ind2-$_"} 0 .. $i * 2];
    $data [$i] {rw}        = [map {"val- rw -$_"} 0 .. $i * 2];
    $data [$i] {ro}        = [map {"val- ro -$_"} 0 .. $i * 2];
    $data [$i] {pr}        = [map {"val- pr -$_"} 0 .. $i * 2];
    $data [$i] {priv}      = [map {"val-priv-$_"} 0 .. $i * 2];
    $data [$i] {default}   = [map {"val- def-$_"} 0 .. $i * 2];
    $data [$i] {push}      = [map {"val-push-$_"} 0 .. $i * 2];
    $data [$i] {unshift}   = [map {"val-unsh-$_"} 0 .. $i * 2];
    $data [$i] {splice}    = [map {"val-splc-$_"} 0 .. $i * 3];
}

#
# Set ro/pr/priv/default values by other means.
#
for my $i (0 .. N - 1) {
    $obj [$i] ->    set_a_rw     ([@{$data [$i] {rw}}]);
    $obj [$i] -> my_set_a_ro      (@{$data [$i] {ro}});
    $obj [$i] -> my_set_a_pr      (@{$data [$i] {pr}});
    $obj [$i] -> my_set_a_priv    (@{$data [$i] {priv}});
    $obj [$i] -> my_set_a_default (@{$data [$i] {default}});
}

#
# Query empty array
#
for my $i (0 .. N - 1) {
    my @a = $obj [$i] -> reference;
    my @b;
    is_deeply \@a, \@b, "Empty array";

    my $a = $obj [$i] -> reference;
    my $b = 0;
    is $a, $b, "Empty array (scalar)";

    my $c = $obj [$i] -> reference (0);
    my $d;
    is $c, $d, "Empty array (index)";

    my @e = $obj [$i] -> reference (1, 2);
    my @f = (undef, undef);
    is_deeply \@e, \@f, "Empty array (slice)";
}


for my $i (0 .. N - 1) {
    for my $f (qw /rw ro/) {
        my $method = "a_$f";

        my @a = $obj [$i] -> $method;
        my @b = @{$data [$i] {$f}};
        is_deeply \@a, \@b, "$f return value ($i)";

        my $a = $obj [$i] -> $method;
        my $b = @{$data [$i] {$f}};
        is $a, $b, "$f scalar return value ($i)";

        for my $j (0 .. 2 * $i) {
            my $a = $obj [$i] -> $method ($j);
            my $b = ${$data [$i] {$f}} [$j];
            is $a, $b, "$f by index ($i, $j)";
        }

        # Slice.
        my @i = map {$_ * 2} 0 .. $i;
        my @c = $obj [$i] -> $method (@i);
        my @d = @{$data [$i] {$f}} [@i];
        is_deeply \@c, \@d, "$f slice return value ($i)";
    }

    for my $f (qw /pr priv default/) {
        my $method = "my_get_a_$f";

        my @c = $obj [$i] -> $method;
        my @d = @{$data [$i] {$f}};
        is_deeply \@c, \@d, "$f return value ($i)";
    }

}


#
# Test rw functions.
#

for my $i (0 .. N - 1) {
    $obj [$i] -> set_reference ($data [$i] {reference});
    # Index by index.
    for my $j (0 .. $i * 2) {
        $obj [$i] -> set_index ($j, $data [$i] {index} [$j]);
    }
    # Complete set
    $obj [$i] -> set_index2 (map {$_ => $data [$i] {index2} [$_]} 0 .. $i * 2);
}
for my $i (0 .. N - 1) {
    # Get complete arrays.
    my @a = $obj [$i] -> reference;
    my @b = @{$data [$i] {reference}};
    is_deeply \@a, \@b, "'reference' return value ($i)";

    my $a = $obj [$i] -> reference;
    my $b = @{$data [$i] {reference}};
    is $a, $b, "'reference' scalar return value ($i)";

    my @c = $obj [$i] -> index;
    my @d = @{$data [$i] {index}};
    is_deeply \@c, \@d, "'index' return value ($i)";

    my $c = $obj [$i] -> index;
    my $d = @{$data [$i] {index}};
    is $c, $d, "'index' scalar return value ($i)";

    my @i = $obj [$i] -> index2;
    my @j = @{$data [$i] {index2}};
    is_deeply \@i, \@j, "'index2' return value ($i)";

    my $I = $obj [$i] -> index2;
    my $j = @{$data [$i] {index2}};
    is $I, $j, "'index2' scalar return value ($i)";

    # Get elements.
    for my $j (0 .. $i) {
        my $a = $obj [$i] -> reference ($j);
        my $b = $data [$i] {reference} [$j];
        is $a, $b, "'reference ($j)' return value ($i)";

        my $c = $obj [$i] -> index ($j);
        my $d = $data [$i] {index} [$j];
        is $c, $d, "'index ($j)' return value ($i)";
    }

    # Get slices.
    my @e = $obj [$i] -> reference (map {$_ * 2} 0 .. $i);
    my @f = @{$data [$i] {reference}} [map {$_ * 2} 0 .. $i];
    is_deeply \@e, \@f, "'reference' (slice) return value ($i)";

    my @g = $obj [$i] -> index (map {$_ * 2} 0 .. $i);
    my @h = @{$data [$i] {index}} [map {$_ * 2} 0 .. $i];
    is_deeply \@g, \@h, "'index' (slice) return value ($i)";

}

# Overwrite values.
for my $i (0 .. N - 1) {
    for my $k (0 .. $i) {
        my $j = $k * 2;
        $obj [$i] -> set_index ($j, $data [$i] {index2} [$j]);
    }
}
for my $i (0 .. N - 1) {
    for my $j (0 .. $i * 2) {
        my $a = $obj [$i] -> index ($j);
        my $b = $data [$i] {$j % 2 ? "index" : "index2"} [$j];
        is $a, $b, "'index2 ($j) return value ($i)";
    }
}

# Clear array.
for my $i (0 .. N - 1) {
    $obj [$i] -> set_reference;
}
for my $i (0 .. N - 1) {
    my @a = $obj [$i] -> reference;
    my @b = ();
    is_deeply \@a, \@b, "reference empty ($i)";
}

# Delete elements.
for my $i (0 .. N - 1) {
    my $a = $obj [$i] -> set_index2 ($i * 2);
    my $b = $obj [$i];
    is $a, $b, "index2 delete last ($i)";
}
for my $i (0 .. N - 1) {
    my  @a = $obj [$i] -> index2;
    my  @b = @{$data [$i] {index2}};
    pop @b;
    is_deeply \@a, \@b, "index2 popped ($i)";

    my  $a = $obj [$i] -> index2;
    my  $b = @b;
    is  $a, $b, "index2 popped (scalar) ($i)";
}
for my $i (0 .. N - 1) {
    my $a = $obj [$i] -> set_index2 (0);
    my $b = $obj [$i];
    is $a, $b, "index2 delete first ($i)";
}
for my $i (0 .. N - 1) {
    my  @a = $obj [$i] -> index2;
    my  @b = @{$data [$i] {index2}};
    pop @b;
    undef $b [0] if @b;
    is_deeply \@a, \@b, "index2 popped ($i)";

    my  $a = $obj [$i] -> index2;
    my  $b = @b;
    is  $a, $b, "index2 popped (scalar) ($i)";
}



#
# Array operations.
#

# push/$#/slice.
for my $i (0 .. N - 1) {
    $obj [$i] -> push_array (@{$data [$i] {push}});
}
for my $i (0 .. N - 1) {
    my @a = $obj [$i] -> array;
    my $a = $obj [$i] -> count_array;
    my @b = @{$data [$i] {push}};
    my $b = @b;
    is_deeply \@a, \@b, "push ($i)";
    is ($a, $b - 1, '$#.array ($i)');

    my @i = map {2 * $_} 0 .. $i;
    my @c = $obj [$i] -> slice_array (@i);
    my @d = @{$data [$i] {push}} [@i];
    is_deeply \@c, \@d, "slice ($i)";
}

# unshift/pop/shift.
for my $i (0 .. N - 1) {
    $obj [$i] -> unshift_array (@{$data [$i] {unshift}});
}
for my $i (0 .. N - 1) {
    my @a = $obj [$i] -> array;
    my $a = $obj [$i] -> count_array;
    my @b = map {@$_} @{$data [$i]} {qw /unshift push/};
    my $b = @b;
    is_deeply \@a, \@b, "unshift ($i)";
    is ($a, $b - 1, '$#.array ($i)');

    my $c = $obj [$i] -> pop_array;
    my $d = pop @b;
    my @c = $obj [$i] -> array;
    is $c, $d, "pop return ($i)";
    is_deeply \@c, \@b, "pop ($i)";

    my $e = $obj [$i] -> shift_array;
    my $f = shift @b;
    my @e = $obj [$i] -> array;
    is $e, $f, "pop return ($i)";
    is_deeply \@e, \@b, "pop ($i)";
}

# splice
for my $i (0 .. N - 1) {
    $obj [$i] -> set_array ([@{$data [$i] {splice}}]);
}
for my $i (0 .. N - 1) {
    my @a = $obj [$i] -> splice_array ($i, $i);
    my @b = @{$data [$i] {splice}} [$i .. 2 * $i - 1];
    is_deeply \@a, \@b, "splice ($i)";

    my @c = $obj [$i] -> array;
    my @d = @{$data [$i] {splice}} [0 .. $i - 1, 2 * $i .. 3* $i];
    is_deeply \@c, \@d, "splice left ($i)";
}


#
# How many entries?
#
my @a = Array -> give_status;
my @b = (0, (N) x (KEYS - 1), 0);
is_deeply (\@a, \@b, "status (0)");

for my $i (0 .. N - 1) {
    undef $obj [$i];
    my @a = Array -> give_status;
    my @b = (0, (N - ($i + 1)) x (KEYS - 1), 0);
    is_deeply (\@a, \@b, sprintf "status (%d)" => $i + 1);
}
@a = Array -> give_status;
@b = (0) x (KEYS + 1);
is_deeply (\@a, \@b, "final status");

__END__