5 unshift @INC, '../lib';
10 package Tie::BasicArray;
12 sub TIEARRAY { bless [], $_[0] }
13 sub STORE { $_[0]->[$_[1]] = $_[2] }
14 sub FETCH { $_[0]->[$_[1]] }
15 sub FETCHSIZE { scalar(@{$_[0]})}
16 sub STORESIZE { $#{$_[0]} = $_[1]+1 }
39 if ($#keys == 2 && $#values == 2) {print "ok 1\n";} else {print "not ok 1\n";}
41 $i = 0; # stop -w complaints
43 while (($key,$value) = each %$a) {
44 if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
46 $i++ if $key eq $value;
50 if ($i == 3) {print "ok 2\n";} else {print "not ok 2\n";}
52 # quick check with tied array
53 tie @fake, 'Tie::StdArray';
58 if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";}
60 # quick check with tied array
61 tie @fake, 'Tie::BasicArray';
66 if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";}
68 # quick check with tied array & tied hash
70 tie %fake, Tie::StdHash;
75 if ($a->{'abc'} eq 'ABC') {print "ok 5\n";} else {print "not ok 5\n";}
78 my $slice = join('', 'x',@$a{'abc','def'},'x');
79 print "not " if $slice ne 'xABCx';
82 # evaluation in scalar context
84 print "not " if %$avhv;
88 print "not " if %$avhv;
93 print "not " unless $@ and $@ =~ /^Can't coerce array into hash/;
96 $avhv = [{foo=>1, bar=>2}];
97 print "not " unless %$avhv =~ m,^\d+/\d+,;
100 # check if defelem magic works
102 print "not " unless $_[0] eq 'a';
106 $a = [{key => 1}, 'a'];
108 print "not " unless $a->[1] eq 'b';
111 # check if exists() is behaving properly
112 $avhv = [{foo=>1,bar=>2,pants=>3}];
113 print "not " if exists $avhv->{bar};
116 $avhv->{pants} = undef;
117 print "not " unless exists $avhv->{pants};
119 print "not " if exists $avhv->{bar};