X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Ftiearray.t;h=e7b547bcd9030caeadcd9111f6b2516e9fce8ef2;hb=3511154c18a0900e8873e8e72a4b74931525e718;hp=9544f89f7478f9bb2644a64693a0513463a28771;hpb=74d0c54f3328524c981198a2cf62d5ec89089dc8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/tiearray.t b/t/op/tiearray.t index 9544f89..e7b547b 100755 --- a/t/op/tiearray.t +++ b/t/op/tiearray.t @@ -99,9 +99,44 @@ sub SPLICE return splice(@$ob,$off,$len,@_); } -package main; +package NegIndex; # 20020220 MJD +@ISA = 'Implement'; + +# simulate indices -2 .. 2 +my $offset = 2; +$NegIndex::NEGATIVE_INDICES = 1; + +sub FETCH { + my ($ob,$id) = @_; +# print "# FETCH @_\n"; + $id += $offset; + $ob->[$id]; +} + +sub STORE { + my ($ob,$id,$value) = @_; +# print "# STORE @_\n"; + $id += $offset; + $ob->[$id] = $value; +} + +sub DELETE { + my ($ob,$id) = @_; +# print "# DELETE @_\n"; + $id += $offset; + delete $ob->[$id]; +} + +sub EXISTS { + my ($ob,$id) = @_; +# print "# EXISTS @_\n"; + $id += $offset; + exists $ob->[$id]; +} -print "1..36\n"; +package main; + +print "1..61\n"; my $test = 1; {my @ary; @@ -224,7 +259,7 @@ untie @ary; } # 20020401 mjd-perl-patch+@plover.com -# Thanks to Dave Mitchell for the small test case +# Thanks to Dave Mitchell for the small test case and the fix { my @a; @@ -240,9 +275,55 @@ untie @ary; # If we survived this far. print "ok ", $test++, "\n"; } - -print "not " unless $seen{'DESTROY'} == 2; -print "ok ", $test++,"\n"; +{ # 20020220 mjd-perl-patch+@plover.com + my @n; + tie @n => 'NegIndex', ('A' .. 'E'); + + # FETCH + print "not " unless $n[0] eq 'C'; + print "ok ", $test++,"\n"; + print "not " unless $n[1] eq 'D'; + print "ok ", $test++,"\n"; + print "not " unless $n[2] eq 'E'; + print "ok ", $test++,"\n"; + print "not " unless $n[-1] eq 'B'; + print "ok ", $test++,"\n"; + print "not " unless $n[-2] eq 'A'; + print "ok ", $test++,"\n"; + + # STORE + $n[-2] = 'a'; + print "not " unless $n[-2] eq 'a'; + print "ok ", $test++,"\n"; + $n[-1] = 'b'; + print "not " unless $n[-1] eq 'b'; + print "ok ", $test++,"\n"; + $n[0] = 'c'; + print "not " unless $n[0] eq 'c'; + print "ok ", $test++,"\n"; + $n[1] = 'd'; + print "not " unless $n[1] eq 'd'; + print "ok ", $test++,"\n"; + $n[2] = 'e'; + print "not " unless $n[2] eq 'e'; + print "ok ", $test++,"\n"; + + # DELETE and EXISTS + for (-2 .. 2) { + print exists($n[$_]) ? "ok $test\n" : "not ok $test\n"; + $test++; + delete $n[$_]; + print defined($n[$_]) ? "not ok $test\n" : "ok $test\n"; + $test++; + print exists($n[$_]) ? "not ok $test\n" : "ok $test\n"; + $test++; + } +} + + + +print "not " unless $seen{'DESTROY'} == 3; +print "ok ", $test++,"\n";