From: Nick Ing-Simmons <nik@tiuk.ti.com>
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 <pcrow@hertz.com>.

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<perltie> 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<PUSH>, C<POP>, C<SHIFT>,
 C<UNSHIFT>, C<SPLICE> and C<CLEAR> in terms of basic C<FETCH>, C<STORE>,
 C<FETCHSIZE>, C<STORESIZE>.
 
-The B<Tie::StdArray> package provides efficient methods required for tied arrays 
+The B<Tie::StdArray> package provides efficient methods required for tied arrays
 which are implemented as blessed references to an "inner" perl array.
-It inherits from B<Tie::Array>, and should cause tied arrays to behave exactly 
-like standard arrays, allowing for selective overloading of methods. 
+It inherits from B<Tie::Array>, 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<perltie> 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<tie @array, classname>. Associates
 an array instance with the specified class. C<LIST> would represent
 additional arguments (along the lines of L<AnyDBM_File> 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<this> to be I<count>. If this makes the array larger then
 class's mapping of C<undef> 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<this>.
 
 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<splice> on the array. 
+Perform the equivalent of C<splice> on the array.
 
-I<offset> is optional and defaults to zero, negative values count back 
-from the end of the array. 
+I<offset> is optional and defaults to zero, negative values count back
+from the end of the array.
 
 I<length> is optional and defaults to rest of the array.
 
@@ -277,16 +278,15 @@ Returns a list of the original I<length> elements at I<offset>.
 
 =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 E<lt>nik@tiuk.ti.comE<gt>
 
-=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";