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

# TODO:
# return @u = (@a, @b);
# this returns strange, (undefined ?) value

use strict;
use warnings;
use Test::More;
plan tests => (29);


# ---------------------------------------------------
# Check if module is loading
# ---------------------------------------------------
eval { require Array::Unique; };
is($@, '', 'Load module Array::Unique');
die $@ if $@;

# ---------------------------------------------------
# New instance creation
# ---------------------------------------------------
my @a;
my $o;

my @b; # help variables
my $b;

eval {$o = tie @a, 'Array::Unique';};
is($@, '', 'tie-ing an array');
die $@ if $@;


@b = @a = qw(a b c a d a b q a);
is(@a, 5, 'length is correct');
is_deeply(\@a, [qw(a b c d q)], 'create an array where there were dupplicates');

is($a[0],  "a", 'fetch the value of element 0');
is($a[3],  "d", 'fetch the value of element 3');
is($a[10],  undef, 'fetch the value of too high index');
is($a[-1], "q", 'fetch the value of element -1');
is($a[-2], "d", 'fetch the value of element -2');



TODO: {
    local $TODO = 'transferes the length of the original list and we
    get undefs at the end';
is(@b, 5, 'length is correct');
is_deeply(\@b, [qw(a b c d q)], 'transfere assignment');
}

@b=@a;
is(@b, 5, 'length is correct');


$b = $a[4] = 'b';
is_deeply(\@a, [qw(a b c d)], 'replace a value with an existing value');
TODO: {
  local $TODO='passing the new value not the one received';
is($b, 'b', 'assigned value gets transfered');

}

$b = $a[1] = 'x';
is_deeply(\@a, [qw(a x c d)], 'replace a value with a new value');
is($b, 'x', 'assigned value gets transfered');


$b = $a[1] = 'd';
is_deeply(\@a, [qw(a d c)], 'replace a value with an existing value');
is($b, 'd', 'assigned value gets transfered');


$b = $a[1] = 'd';
is_deeply(\@a, [qw(a d c)], 'replace a value in the same location');
is($b, 'd', 'assigned value gets transfered');


$b = $a[6] = 'a';
is_deeply(\@a, [qw(a d c)], '');
TODO: {
  local $TODO='passing the new value not the one received';
is($b, 'a', 'assigned value gets transfered');
}



# ---------------------------------------------------
# Set the value of negative indexes
# ---------------------------------------------------
@a = qw(a b c d e);

$b = $a[-1] = "a";
is_deeply(\@a, [qw(a b c d)], 'Set the value of negative indexes, -1');
TODO: {
  local $TODO='passing the new value not the one received';
is($b, 'a', 'assigned value gets transfered');
}

$b = $a[-2] = "d";
is_deeply(\@a, [qw(a b d)], 'Set the value of negative indexes -2');
is($b, 'd', 'assigned value gets transfered');



$#a=1;
is_deeply(\@a, [qw(a b)], 'change the size of the array');

is($#a, 1, 'highest index corect');

is(@a, 2, 'size correct');


=pod

# ---------------------------------------------------
# push
# ---------------------------------------------------
push @a, qw;
ok("@a" eq "a b");
#print "DEBUG: '@a'\n";

push @a, 'c', 'd';
ok("@a" eq "a b c d");
#print "DEBUG: @a\n";

push @a, qw(x y d z a);
ok("@a" eq "a b c d x y z");
#print "DEBUG: @a\n";

=cut


TODO: {
   local $TODO = 'wait';


}
__END__




# ---------------------------------------------------
# splice
# ---------------------------------------------------
my @b = splice(@a, 2, 3);
ok("@b" eq "c d x");
#print "DEBUG: '@b'\n";
ok("@a" eq "a b y z");
#print "DEBUG: '@a'\n";

@b = splice(@a, 2, 1, qw(z a u));
ok("@b" eq "y");
#print "DEBUG: '@b'\n";
ok("@a" eq "a b z u");
#print "DEBUG: '@a'\n";

# ---------------------------------------------------
# splice with negative values
# ---------------------------------------------------
@a = qw(a b c d e f g h i j k l);
@b = splice (@a, -1);
is_deeply(\@b, [qw(l)], '');
#print "DEBUG: '@b'\n";
is_deeply(\@a, [qw(a b c d e f g h i j k)],'');
#print "DEBUG: '@a'\n";

@b = splice (@a, -7, 4, qw(z));
is_deeply(\@b, [qw(e f g h)], '');
#print "DEBUG: '@b'\n";
is_deeply(\@a, [qw(a b c d z i j k)], '');
#print "DEBUG: '@a'\n";


# ---------------------------------------------------
# unshift
# ---------------------------------------------------
@a = qw(a b z u);
unshift @a, qw(d a w);
is_deeply(\@a, [qw(d a w b z u)], '');
#print "DEBUG: '@a'\n";


# ---------------------------------------------------
# pop
# ---------------------------------------------------
my $p = pop(@a);
is($p, "u", '');
is_deeply(\@a, [qw(d a w b z)], '');

# ---------------------------------------------------
# shift
# ---------------------------------------------------
my $s = shift @a;
is($s, "d", '');
is_deeply(\@a, [qw(a w b z)], '');