#!./perl
+
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
{
$seen{'STORESIZE'}++;
my ($ob,$sz) = @_;
- return @$ob = $sz;
+ return $#{$ob} = $sz-1;
}
sub EXTEND
sub FETCHSIZE
{
$seen{'FETCHSIZE'}++;
- my ($ob) = @_;
- return @$ob-1;
+ return scalar(@{$_[0]});
}
sub FETCH
sub UNSHIFT
{
$seen{'UNSHIFT'}++;
- $ob = shift;
+ my $ob = shift;
unshift(@$ob,@_);
}
sub CLEAR
{
$seen{'CLEAR'}++;
+ @{$_[0]} = ();
+}
+
+sub DESTROY
+{
+ $seen{'DESTROY'}++;
}
sub POP
package main;
-print "1..23\n";
+print "1..36\n";
my $test = 1;
{my @ary;
print "not " unless $seen{'STORE'} >= 3;
print "ok ", $test++,"\n";
-
print "not " unless join(':',@ary) eq '1:2:3';
print "ok ", $test++,"\n";
+{my @thing = @ary;
+print "not " unless join(':',@thing) eq '1:2:3';
+print "ok ", $test++,"\n";
+
+tie @thing,'Implement';
+@thing = @ary;
+print "not " unless join(':',@thing) eq '1:2:3';
+print "ok ", $test++,"\n";
+}
+
print "not " unless pop(@ary) == 3;
print "ok ", $test++,"\n";
print "not " unless $seen{'POP'} == 1;
print "not " unless join(':',@ary) eq '1:7:4';
print "ok ", $test++,"\n";
-
-
print "not " unless shift(@ary) == 1;
print "ok ", $test++,"\n";
print "not " unless $seen{'SHIFT'} == 1;
print "not " unless join(':',@ary) eq '7:4';
print "ok ", $test++,"\n";
-
-unshift(@ary,5);
+my $n = unshift(@ary,5,6);
print "not " unless $seen{'UNSHIFT'} == 1;
print "ok ", $test++,"\n";
-print "not " unless join(':',@ary) eq '5:7:4';
+print "not " unless $n == 4;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '5:6:7:4';
print "ok ", $test++,"\n";
@ary = split(/:/,'1:2:3');
print "not " unless join(':',@ary) eq '1:2:3';
print "ok ", $test++,"\n";
-# untie @ary;
+
+my $t = 0;
+foreach $n (@ary)
+ {
+ print "not " unless $n == ++$t;
+ print "ok ", $test++,"\n";
+ }
+
+# (30-33) 20020303 mjd-perl-patch+@plover.com
+@ary = ();
+$seen{POP} = 0;
+pop @ary; # this didn't used to call POP at all
+print "not " unless $seen{POP} == 1;
+print "ok ", $test++,"\n";
+$seen{SHIFT} = 0;
+shift @ary; # this didn't used to call SHIFT at all
+print "not " unless $seen{SHIFT} == 1;
+print "ok ", $test++,"\n";
+$seen{PUSH} = 0;
+push @ary; # this didn't used to call PUSH at all
+print "not " unless $seen{PUSH} == 1;
+print "ok ", $test++,"\n";
+$seen{UNSHIFT} = 0;
+unshift @ary; # this didn't used to call UNSHIFT at all
+print "not " unless $seen{UNSHIFT} == 1;
+print "ok ", $test++,"\n";
-}
+@ary = qw(3 2 1);
+print "not " unless join(':',@ary) eq '3:2:1';
+print "ok ", $test++,"\n";
+untie @ary;
+}
+# 20020401 mjd-perl-patch+@plover.com
+# Thanks to Dave Mitchell for the small test case and the fix
+{
+ my @a;
+
+ sub X::TIEARRAY { bless {}, 'X' }
+
+ sub X::SPLICE {
+ do '/dev/null';
+ die;
+ }
+
+ tie @a, 'X';
+ eval { splice(@a) };
+ # If we survived this far.
+ print "ok ", $test++, "\n";
+}
+
+print "not " unless $seen{'DESTROY'} == 2;
+print "ok ", $test++,"\n";