avhv.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl
BEGIN {
chdir 't' if -d 't';
}
@ISA = 'Tie::Array';
sub STORE { $_[0]->[$_[1]] = $_[2] }
sub FETCH { $_[0]->[$_[1]] }
sub STORESIZE { $#{$_[0]} = $_[1]+1 }
print "1..28\n";
$sch = {
'abc' => 1,
'def' => 2,
'jkl' => 3,
};
# basic normal array
$a = [];
$a->[0] = $sch;
$a->{'abc'} = 'ABC';
$a->{'def'} = 'DEF';
$a->{'jkl'} = 'JKL';
$i = 0; # stop -w complaints
}
}
if ($i == 3) {print "ok 2\n";} else {print "not ok 2\n";}
# quick check with tied array
$a = \@fake;
$a->[0] = $sch;
$a->{'abc'} = 'ABC';
# quick check with tied array
$a = \@fake;
$a->[0] = $sch;
$a->{'abc'} = 'ABC';
# quick check with tied array & tied hash
$a->[0] = \%fake;
$a->{'abc'} = 'ABC';
# hash slice
print "ok 6\n";
# evaluation in scalar context
my $avhv = [{}];
print "not " if %$avhv;
print "ok 7\n";
print "not " if %$avhv;
print "ok 8\n";
$avhv = [];
eval { $a = %$avhv };
print "ok 9\n";
$avhv = [{foo=>1, bar=>2}];
print "not " unless %$avhv =~ m,^\d+/\d+,;
print "ok 10\n";
# check if defelem magic works
sub f {
print "not " unless $_[0] eq 'a';
$_[0] = 'b';
print "ok 11\n";
}
$a = [{key => 1}, 'a'];
f($a->{key});
print "not " unless $a->[1] eq 'b';
print "ok 12\n";
# check if exists() is behaving properly
$avhv = [{foo=>1,bar=>2,pants=>3}];
print "not " if exists $avhv->{bar};
print "ok 13\n";
$avhv->{pants} = undef;
print "not " unless exists $avhv->{pants};
print "ok 14\n";
print "not " if exists $avhv->{bar};
print "ok 15\n";
$avhv->{bar} = 10;
print "not " unless exists $avhv->{bar} and $avhv->{bar} == 10;
print "ok 16\n";
$v = delete $avhv->{bar};
print "not " unless $v == 10;
print "ok 17\n";
print "not " if exists $avhv->{bar};
print "ok 18\n";
print "# @x\nnot " unless "@x" eq "xxx zzz";
print "ok 19\n";
print "not " unless "$avhv->{bar}" eq "yyy";
print "ok 20\n";
# hash assignment
%$avhv = ();
print "ok 21\n";
%hv = %$avhv;
print "not " if grep defined, values %hv;
print "ok 22\n";
print "not " if grep ref, keys %hv;
print "ok 23\n";
%$avhv = (foo => 29, pants => 2, bar => 0);
print "not " unless "@$avhv[1..3]" eq '29 0 2';
print "ok 24\n";
my $extra;
my @extra;
($extra, %$avhv) = ("moo", foo => 42, pants => 53, bar => "HIKE!");
print "ok 25\n";
%$avhv = ();
(%$avhv, $extra) = (foo => 42, pants => 53, bar => "HIKE!");
print "ok 26\n";
@extra = qw(whatever and stuff);
%$avhv = ();
(%$avhv, @extra) = (foo => 42, pants => 53, bar => "HIKE!");
print "ok 27\n";
%$avhv = ();
(@extra, %$avhv) = (foo => 42, pants => 53, bar => "HIKE!");
print "ok 28\n";