From: Nick Ing-Simmons Date: Thu, 5 Oct 2000 09:37:11 +0000 (+0100) Subject: Re: Questions about Tie::Array and perl modules X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7517970fb027d70a681529abbff1c6444576c7e9;p=p5sagit%2Fp5-mst-13.2.git Re: Questions about Tie::Array and perl modules Message-Id: <200010050837.JAA00564@mikado.tiuk.ti.com> Bug reported and fix suggested by Philip D Crow . p4raw-id: //depot/perl@7151 --- diff --git a/lib/Tie/Array.pm b/lib/Tie/Array.pm index eb83aae..e3b85d4 100644 --- a/lib/Tie/Array.pm +++ b/lib/Tie/Array.pm @@ -8,30 +8,31 @@ our $VERSION = '1.01'; # Pod documentation after __END__ below. sub DESTROY { } -sub EXTEND { } -sub UNSHIFT { shift->SPLICE(0,0,@_) } -sub SHIFT { shift->SPLICE(0,1) } +sub EXTEND { } +sub UNSHIFT { scalar shift->SPLICE(0,0,@_) } +sub SHIFT { shift->SPLICE(0,1) } +#sub SHIFT { (shift->SPLICE(0,1))[0] } sub CLEAR { shift->STORESIZE(0) } -sub PUSH -{ +sub PUSH +{ my $obj = shift; my $i = $obj->FETCHSIZE; $obj->STORE($i++, shift) while (@_); } -sub POP +sub POP { my $obj = shift; my $newsize = $obj->FETCHSIZE - 1; my $val; - if ($newsize >= 0) + if ($newsize >= 0) { $val = $obj->FETCH($newsize); $obj->STORESIZE($newsize); } $val; -} +} sub SPLICE { @@ -46,7 +47,7 @@ sub SPLICE push(@result,$obj->FETCH($off+$i)); } if (@_ > $len) - { + { # Move items up to make room my $d = @_ - $len; my $e = $off+$len; @@ -59,7 +60,7 @@ sub SPLICE } elsif (@_ < $len) { - # Move items down to close the gap + # Move items down to close the gap my $d = $len - @_; my $e = $off+$len; for (my $i=$off+$len; $i < $sz; $i++) @@ -74,7 +75,7 @@ sub SPLICE $obj->STORE($off+$i,$_[$i]); } return @result; -} +} sub EXISTS { my $pkg = ref $_[0]; @@ -91,21 +92,21 @@ use vars qw(@ISA); @ISA = 'Tie::Array'; sub TIEARRAY { bless [], $_[0] } -sub FETCHSIZE { scalar @{$_[0]} } -sub STORESIZE { $#{$_[0]} = $_[1]-1 } +sub FETCHSIZE { scalar @{$_[0]} } +sub STORESIZE { $#{$_[0]} = $_[1]-1 } sub STORE { $_[0]->[$_[1]] = $_[2] } sub FETCH { $_[0]->[$_[1]] } sub CLEAR { @{$_[0]} = () } -sub POP { pop(@{$_[0]}) } +sub POP { pop(@{$_[0]}) } sub PUSH { my $o = shift; push(@$o,@_) } -sub SHIFT { shift(@{$_[0]}) } -sub UNSHIFT { my $o = shift; unshift(@$o,@_) } +sub SHIFT { shift(@{$_[0]}) } +sub UNSHIFT { my $o = shift; unshift(@$o,@_) } sub EXISTS { exists $_[0]->[$_[1]] } sub DELETE { delete $_[0]->[$_[1]] } sub SPLICE { - my $ob = shift; + my $ob = shift; my $sz = $ob->FETCHSIZE; my $off = @_ ? shift : 0; $off += $sz if $off < 0; @@ -121,16 +122,16 @@ __END__ Tie::Array - base class for tied arrays -=head1 SYNOPSIS +=head1 SYNOPSIS package NewArray; use Tie::Array; @ISA = ('Tie::Array'); # mandatory methods - sub TIEARRAY { ... } - sub FETCH { ... } - sub FETCHSIZE { ... } + sub TIEARRAY { ... } + sub FETCH { ... } + sub FETCHSIZE { ... } sub STORE { ... } # mandatory if elements writeable sub STORESIZE { ... } # mandatory if elements can be added/deleted @@ -138,13 +139,13 @@ Tie::Array - base class for tied arrays sub DELETE { ... } # mandatory if delete() expected to work # optional methods - for efficiency - sub CLEAR { ... } - sub PUSH { ... } - sub POP { ... } - sub SHIFT { ... } - sub UNSHIFT { ... } - sub SPLICE { ... } - sub EXTEND { ... } + sub CLEAR { ... } + sub PUSH { ... } + sub POP { ... } + sub SHIFT { ... } + sub UNSHIFT { ... } + sub SPLICE { ... } + sub EXTEND { ... } sub DESTROY { ... } package NewStdArray; @@ -162,7 +163,7 @@ Tie::Array - base class for tied arrays -=head1 DESCRIPTION +=head1 DESCRIPTION This module provides methods for array-tying classes. See L for a list of the functions required in order to tie an array @@ -173,16 +174,16 @@ on the tied array, and implementations of C, C, C, C, C and C in terms of basic C, C, C, C. -The B package provides efficient methods required for tied arrays +The B package provides efficient methods required for tied arrays which are implemented as blessed references to an "inner" perl array. -It inherits from B, and should cause tied arrays to behave exactly -like standard arrays, allowing for selective overloading of methods. +It inherits from B, and should cause tied arrays to behave exactly +like standard arrays, allowing for selective overloading of methods. For developers wishing to write their own tied arrays, the required methods are briefly defined below. See the L section for more detailed descriptive, as well as example code: -=over +=over =item TIEARRAY classname, LIST @@ -190,7 +191,7 @@ The class method is invoked by the command C. Associates an array instance with the specified class. C would represent additional arguments (along the lines of L and compatriots) needed to complete the association. The method should return an object of a class which -provides the methods below. +provides the methods below. =item STORE this, index, value @@ -214,7 +215,7 @@ Sets the total number of items in the tied array associated with object I to be I. If this makes the array larger then class's mapping of C should be returned for new positions. If the array becomes smaller then entries beyond count should be -deleted. +deleted. =item EXTEND this, count @@ -242,7 +243,7 @@ object I. Normal object destructor method. -=item PUSH this, LIST +=item PUSH this, LIST Append elements of LIST to the array. @@ -255,17 +256,17 @@ Remove last element of the array and return it. Remove the first element of the array (shifting other elements down) and return it. -=item UNSHIFT this, LIST +=item UNSHIFT this, LIST Insert LIST elements at the beginning of the array, moving existing elements up to make room. =item SPLICE this, offset, length, LIST -Perform the equivalent of C on the array. +Perform the equivalent of C on the array. -I is optional and defaults to zero, negative values count back -from the end of the array. +I is optional and defaults to zero, negative values count back +from the end of the array. I is optional and defaults to rest of the array. @@ -277,16 +278,15 @@ Returns a list of the original I elements at I. =head1 CAVEATS -There is no support at present for tied @ISA. There is a potential conflict +There is no support at present for tied @ISA. There is a potential conflict between magic entries needed to notice setting of @ISA, and those needed to -implement 'tie'. +implement 'tie'. Very little consideration has been given to the behaviour of tied arrays when C<$[> is not default value of zero. -=head1 AUTHOR +=head1 AUTHOR Nick Ing-Simmons Enik@tiuk.ti.comE -=cut - +=cut diff --git a/t/op/array.t b/t/op/array.t index 97a4a40..7cc84e3 100755 --- a/t/op/array.t +++ b/t/op/array.t @@ -1,6 +1,6 @@ #!./perl -print "1..66\n"; +print "1..70\n"; # # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them @@ -216,3 +216,16 @@ reify('ok'); print "not " unless qw(foo bar snorfle)[2] eq 'snorfle'; print "ok 66\n"; +@ary = (12,23,34,45,56); + +print "not " unless shift(@ary) == 12; +print "ok 67\n"; + +print "not " unless pop(@ary) == 56; +print "ok 68\n"; + +print "not " unless push(@ary,56) == 4; +print "ok 69\n"; + +print "not " unless unshift(@ary,12) == 5; +print "ok 70\n";