TIEARRAY updates - almost works ...

p4raw-id: //depot/ansiperl@424

17 files changed, 418 insertions, 76 deletions

diff --git a/MANIFEST b/MANIFEST
index 07a4742cc9..f09a24125b 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -736,7 +736,9 @@ t/lib/soundex.t		See if Soundex works
 t/lib/symbol.t		See if Symbol works
 t/lib/texttabs.t	See if Text::Tabs works
 t/lib/textwrap.t	See if Text::Wrap works
-t/lib/timelocal.t	See if Time::Local works
+t/lib/tie-push.t	Test for Tie::Array
+t/lib/tie-stdarray.t	Test for Tie::StdArray
+lib/tie-stdpush.t	Test for Tie::StdArray
 t/lib/thread.t		Basic test of threading (skipped if no threads) 
 t/lib/trig.t		See if Math::Trig works
 t/op/append.t		See if . works
diff --git a/av.c b/av.c
index e715d10b63..5925a17869 100644
--- a/av.c
+++ b/av.c
@@ -56,7 +56,7 @@ av_extend(AV *av, I32 key)
 	PUSHMARK(sp);
 	EXTEND(sp,2);
 	PUSHs(mg->mg_obj);
-	PUSHs(sv_2mortal(newSViv(key)));
+	PUSHs(sv_2mortal(newSViv(key+1)));
         PUTBACK;
 	perl_call_method("EXTEND", G_SCALAR|G_DISCARD);
 	FREETMPS;
@@ -321,7 +321,7 @@ av_clear(register AV *av)
 	warn("Attempt to clear deleted array");
     }
 #endif
-    if (!av || AvMAX(av) < 0)
+    if (!av)
 	return;
     /*SUPPRESS 560*/
 
@@ -329,6 +329,9 @@ av_clear(register AV *av)
     if (SvRMAGICAL(av))
 	mg_clear((SV*)av); 
 
+    if (AvMAX(av) < 0)
+	return;
+
     if (AvREAL(av)) {
 	ary = AvARRAY(av);
 	key = AvFILLp(av) + 1;
@@ -389,8 +392,10 @@ av_push(register AV *av, SV *val)
 	EXTEND(sp,2);
 	PUSHs(mg->mg_obj);
 	PUSHs(val);
-        PUTBACK;
+	PUTBACK;
+	ENTER;
 	perl_call_method("PUSH", G_SCALAR|G_DISCARD);
+	LEAVE;
 	return;
     }
     av_store(av,AvFILLp(av)+1,val);
@@ -410,12 +415,14 @@ av_pop(register AV *av)
 	dSP;    
 	PUSHMARK(sp);
 	XPUSHs(mg->mg_obj);
-        PUTBACK;
+	PUTBACK;
+	ENTER;
 	if (perl_call_method("POP", G_SCALAR)) {
 	    retval = newSVsv(*stack_sp--);    
 	} else {    
 	    retval = &sv_undef;
 	}
+	LEAVE;
 	return retval;
     }
     retval = AvARRAY(av)[AvFILLp(av)];
@@ -446,7 +453,9 @@ av_unshift(register AV *av, register I32 num)
 	    PUSHs(&sv_undef);
 	}
 	PUTBACK;
+	ENTER;
 	perl_call_method("UNSHIFT", G_SCALAR|G_DISCARD);
+	LEAVE;
 	return;
     }
 
@@ -495,12 +504,14 @@ av_shift(register AV *av)
 	dSP;
 	PUSHMARK(sp);
 	XPUSHs(mg->mg_obj);
-        PUTBACK;
+	PUTBACK;
+	ENTER;
 	if (perl_call_method("SHIFT", G_SCALAR)) {
 	    retval = newSVsv(*stack_sp--);            
 	} else {    
 	    retval = &sv_undef;
-	}
+	}     
+	LEAVE;
 	return retval;
     }
     retval = *AvARRAY(av);
@@ -535,7 +546,7 @@ av_fill(register AV *av, I32 fill)
 	PUSHMARK(sp);
 	EXTEND(sp,2);
 	PUSHs(mg->mg_obj);
-	PUSHs(sv_2mortal(newSViv(fill)));
+	PUSHs(sv_2mortal(newSViv(fill+1)));
 	PUTBACK;
 	perl_call_method("STORESIZE", G_SCALAR|G_DISCARD);
 	FREETMPS;
diff --git a/av.h b/av.h
index fd34cb0dbc..8de81f42e4 100644
--- a/av.h
+++ b/av.h
@@ -47,6 +47,5 @@ struct xpvav {
 #define AvREALISH(av)	(AvFLAGS(av) & (AVf_REAL|AVf_REIFY))
                                           
 #define AvFILL(av)	((SvRMAGICAL((SV *) (av))) \
-			    ? mg_size((SV *) av) \
-			    : AvFILLp(av))
+			  ? mg_size((SV *) av) : AvFILLp(av))
 
diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index 4e7f0c696a..812464361a 100644
--- a/ext/DB_File/DB_File.pm
+++ b/ext/DB_File/DB_File.pm
@@ -191,11 +191,7 @@ require DynaLoader;
 
 );  
 
-sub FETCHSIZE
-{ 
-    my $self = shift ;
-    return $self->length - 1;
-}
+*FETCHSIZE = \&length;
 
 sub AUTOLOAD {
     my($constname);
diff --git a/lib/Tie/Array.pm b/lib/Tie/Array.pm
index c3ddfa9a8a..336e003b25 100644
--- a/lib/Tie/Array.pm
+++ b/lib/Tie/Array.pm
@@ -1,6 +1,103 @@
-package Tie::Array; 
+package Tie::Array;
+use vars qw($VERSION); 
+use strict;
+$VERSION = '1.00';
 
-# No content yet - just pod skeleton.
+# Pod documentation after __END__ below.
+
+sub DESTROY { }
+sub EXTEND  { }          
+sub UNSHIFT { shift->SPLICE(0,0,@_) }                 
+sub SHIFT   { shift->SPLICE(0,1) }                 
+sub CLEAR   { shift->STORESIZE(0) }
+
+sub PUSH 
+{  
+ my $obj = shift;
+ my $i   = $obj->FETCHSIZE;
+ $obj->STORE($i++, shift) while (@_);
+}
+
+sub POP 
+{
+ my $obj = shift;
+ my $newsize = $obj->FETCHSIZE - 1;
+ my $val;
+ if ($newsize >= 0) 
+  {
+   $val = $obj->FETCH($newsize);
+   $obj->SETSIZE($newsize);
+  }
+ $val;
+}          
+
+sub SPLICE
+{
+ my $obj = shift;
+ my $sz  = $obj->FETCHSIZE;
+ my $off = (@_) ? shift : 0;
+ $off += $sz if ($off < 0);
+ my $len = (@_) ? shift : $sz - $off;
+ my @result;
+ for (my $i = 0; $i < $len; $i++)
+  {
+   push(@result,$obj->FETCH($off+$i));
+  }
+ if (@_ > $len)
+  {                          
+   # Move items up to make room
+   my $d = @_ - $len;
+   my $e = $off+$len;
+   $obj->EXTEND($sz+$d);
+   for (my $i=$sz-1; $i >= $e; $i--)
+    {
+     my $val = $obj->FETCH($i);
+     $obj->STORE($i+$d,$val);
+    }
+  }
+ elsif (@_ < $len)
+  {
+   # Move items down to close the gap 
+   my $d = $len - @_;
+   my $e = $off+$len;
+   for (my $i=$off+$len; $i < $sz; $i++)
+    {
+     my $val = $obj->FETCH($i);
+     $obj->STORE($i-$d,$val);
+    }
+   $obj->STORESIZE($sz-$d);
+  }
+ for (my $i=0; $i < @_; $i++)
+  {
+   $obj->STORE($off+$i,$_[$i]);
+  }
+ return @result;
+} 
+
+package Tie::StdArray;
+use vars qw(@ISA);
+@ISA = 'Tie::Array';
+
+sub TIEARRAY  { bless [], $_[0] }
+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 PUSH      { my $o = shift; push(@$o,@_) }
+sub SHIFT     { shift(@{$_[0]}) } 
+sub UNSHIFT   { my $o = shift; unshift(@$o,@_) } 
+
+sub SPLICE
+{
+ my $ob  = shift;                    
+ my $sz  = $ob->FETCHSIZE;
+ my $off = @_ ? shift : 0;
+ $off   += $sz if $off < 0;
+ my $len = @_ ? shift : $sz-$off;
+ return splice(@$ob,$off,$len,@_);
+}
 
 1;
 
@@ -12,29 +109,154 @@ Tie::Array - base class for tied arrays
 
 =head1 SYNOPSIS  
 
+    package NewArray;
     use Tie::Array;
-    @ISA = 'Tie::Array';
-
-    sub SIZE  { ... } 
-    sub FETCH { ... } 
-    sub STORE { ... } 
-    sub CLEAR { ... } 
+    @ISA = ('Tie::Array');
+                       
+    # mandatory methods
+    sub TIEARRAY { ... }  
+    sub FETCH { ... }     
+    sub FETCHSIZE { ... } 
+        
+    sub STORE { ... }        # mandatory if elements writeable
+    sub STORESIZE { ... }    # mandatory if elements can be added/deleted
+                               
+    # optional methods - for efficiency
+    sub CLEAR { ... }  
     sub PUSH { ... } 
     sub POP { ... } 
     sub SHIFT { ... } 
     sub UNSHIFT { ... } 
     sub SPLICE { ... } 
+    sub EXTEND { ... } 
+    sub DESTROY { ... }
+
+    package NewStdArray;
+    use Tie::Array;
+    
+    @ISA = ('Tie::StdArray');
+
+    # all methods provided by default
+
+    package main;
+
+    $object = tie @somearray,Tie::NewArray;
+    $object = tie @somearray,Tie::StdArray;
+    $object = tie @somearray,Tie::NewStdArray;
+
+
 
 =head1 DESCRIPTION       
 
-This module provides some skeletal methods for array-tying classes.
+This module provides methods for array-tying classes. See
+L<perltie> for a list of the functions required in order to tie an array
+to a package. The basic B<Tie::Array> package provides stub C<DELETE> 
+and C<EXTEND> methods, 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::StdHash> 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 hashes, 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 
+
+=item TIEARRAY classname, LIST
+
+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. 
+
+=item STORE this, index, value
+
+Store datum I<value> into I<index> for the tied array assoicated with
+object I<this>. If this makes the array larger then
+class's mapping of C<undef> should be returned for new positions.
+
+=item FETCH this, index
+
+Retrieve the datum in I<index> for the tied array assoicated with
+object I<this>.
+
+=item FETCHSIZE this
+
+Returns the total number of items in the tied array assoicated with
+object I<this>. (Equivalent to C<scalar(@array)>).
 
+=item STORESIZE this, count
+
+Sets the total number of items in the tied array assoicated 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. 
+
+=item EXTEND this, count
+
+Informative call that array is likely to grow to have I<count> entries.
+Can be used to optimize allocation. This method need do nothing.
+
+=item CLEAR this
+
+Clear (remove, delete, ...) all values from the tied array assoicated with
+object I<this>.
+
+=item DESTROY this
+
+Normal object destructor method.
+
+=item PUSH this, LIST 
+
+Append elements of LIST to the array.
+
+=item POP this
+
+Remove last element of the array and return it.
+
+=item SHIFT this
+
+Remove the first element of the array (shifting other elements down)
+and return it.
+
+=item UNSHIFT this, LIST 
+
+Insert LIST elements at the begining 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. 
+
+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.
+
+I<LIST> may be empty.
+
+Returns a list of the original I<length> elements at I<offset>.
+
+=back
 
 =head1 CAVEATS
 
 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 
+
+Nick Ing-Simmons E<lt>nik@tiuk.ti.comE<gt>
 
 =cut 
 
diff --git a/mg.c b/mg.c
index 289dd3b490..af2dddc87e 100644
--- a/mg.c
+++ b/mg.c
@@ -1009,8 +1009,10 @@ magic_getpack(SV *sv, MAGIC *mg)
 
 int
 magic_setpack(SV *sv, MAGIC *mg)
-{
+{   
+    ENTER;
     magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
+    LEAVE;
     return 0;
 }
 
@@ -1031,7 +1033,7 @@ magic_sizepack(SV *sv, MAGIC *mg)
     SAVETMPS;
     if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
 	sv = *stack_sp--;
-	retval = (U32) SvIV(sv);
+	retval = (U32) SvIV(sv)-1;
     }
     FREETMPS;
     LEAVE;
@@ -1045,9 +1047,9 @@ int magic_wipepack(SV *sv, MAGIC *mg)
     PUSHMARK(sp);
     XPUSHs(mg->mg_obj);
     PUTBACK;
-
+    ENTER;
     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
-
+    LEAVE;
     return 0;
 }
 
diff --git a/pod/perltie.pod b/pod/perltie.pod
index c6eb7156ce..79a749e68a 100644
--- a/pod/perltie.pod
+++ b/pod/perltie.pod
@@ -180,17 +180,26 @@ TIESCALAR classes are certainly possible.
 =head2 Tying Arrays
 
 A class implementing a tied ordinary array should define the following
-methods: TIEARRAY, FETCH, STORE, and perhaps DESTROY.
+methods: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE and perhaps DESTROY. 
 
-B<WARNING>: Tied arrays are I<incomplete>.  They are also distinctly lacking
-something for the C<$#ARRAY> access (which is hard, as it's an lvalue), as
-well as the other obvious array functions, like push(), pop(), shift(),
-unshift(), and splice().
+FETCHSIZE and STORESIZE are used to provide C<$#array> and
+equivalent C<scalar(@array)> access.
+    
+The methods POP, PUSH, SHIFT, UNSHIFT, SPLICE are required if the perl
+operator with the corresponding (but lowercase) name is to operate on the
+tied array. The B<Tie::Array> class can be used as a base class to implement
+these in terms of the basic five methods above.  
+
+In addition EXTEND will be called when perl would have pre-extended 
+allocation in a real array.
+
+This means that tied arrays are now I<complete>. The example below needs
+upgrading to illustrate this. (The documentation in B<Tie::Array> is more
+complete.)
 
 For this discussion, we'll implement an array whose indices are fixed at
 its creation.  If you try to access anything beyond those bounds, you'll
-take an exception.  (Well, if you access an individual element; an
-aggregate assignment would be missed.) For example:
+take an exception.  For example:
 
     require Bounded_Array;
     tie @ary, 'Bounded_Array', 2;
diff --git a/pp.c b/pp.c
index 3d02b09737..b6b30657fa 100644
--- a/pp.c
+++ b/pp.c
@@ -2460,8 +2460,10 @@ PP(pp_splice)
     if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
 	*MARK-- = mg->mg_obj;
 	PUSHMARK(MARK);
-	PUTBACK;
+	PUTBACK;       
+	ENTER;
 	perl_call_method("SPLICE",GIMME_V);
+	LEAVE;
 	SPAGAIN;
 	RETURN;
     }
@@ -2658,17 +2660,19 @@ PP(pp_push)
 	*MARK-- = mg->mg_obj;
 	PUSHMARK(MARK);
 	PUTBACK;
-	perl_call_method("PUSH",GIMME_V);
+	ENTER;
+	perl_call_method("PUSH",G_SCALAR|G_DISCARD);
+	LEAVE;
 	SPAGAIN;
-	RETURN;
     }
-
-    /* Why no pre-extend of ary here ? */
-    for (++MARK; MARK <= SP; MARK++) {
-	sv = NEWSV(51, 0);
-	if (*MARK)
-	    sv_setsv(sv, *MARK);
-	av_push(ary, sv);
+    else {
+	/* Why no pre-extend of ary here ? */
+	for (++MARK; MARK <= SP; MARK++) {
+	    sv = NEWSV(51, 0);
+	    if (*MARK)
+		sv_setsv(sv, *MARK);
+	    av_push(ary, sv);
+	}
     }
     SP = ORIGMARK;
     PUSHi( AvFILL(ary) + 1 );
@@ -2708,20 +2712,23 @@ PP(pp_unshift)
     register I32 i = 0;
     MAGIC *mg;
 
-    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
+    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {            
+
+
 	*MARK-- = mg->mg_obj;
-	PUSHMARK(MARK);
 	PUTBACK;
-	perl_call_method("UNSHIFT",GIMME_V);
+	ENTER;
+	perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD);
+	LEAVE;
 	SPAGAIN;
-	RETURN;
     }
-    
-    av_unshift(ary, SP - MARK);
-    while (MARK < SP) {
-	sv = NEWSV(27, 0);
-	sv_setsv(sv, *++MARK);
-	(void)av_store(ary, i++, sv);
+    else {
+	av_unshift(ary, SP - MARK);
+	while (MARK < SP) {
+	    sv = NEWSV(27, 0);
+	    sv_setsv(sv, *++MARK);
+	    (void)av_store(ary, i++, sv);
+	}
     }
     SP = ORIGMARK;
     PUSHi( AvFILL(ary) + 1 );
diff --git a/pp_hot.c b/pp_hot.c
index 0462886e24..5bff1a14eb 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -297,6 +297,9 @@ PP(pp_print)
 	gv = defoutgv;
     if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
 	if (MARK == ORIGMARK) {
+	    /* If using default handle then we need to make space to 
+	     * pass object as 1st arg, so move other args up ...
+	     */
 	    MEXTEND(SP, 1);
 	    ++MARK;
 	    Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
diff --git a/pp_sys.c b/pp_sys.c
index 85ac7111a2..67cae15e4c 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -590,7 +590,8 @@ PP(pp_untie)
     djSP;
     SV * sv ;
 
-    sv = POPs;
+    sv = POPs;          
+
 
     if (dowarn) {
         MAGIC * mg ;
diff --git a/scope.c b/scope.c
index 3b4428f945..bca1c2b455 100644
--- a/scope.c
+++ b/scope.c
@@ -19,8 +19,16 @@ SV**
 stack_grow(SV **sp, SV **p, int n)
 {
     dTHR;
+#if defined(DEBUGGING) && !defined(USE_THREADS)
+    static int growing = 0;
+    if (growing++)
+      abort();
+#endif
     stack_sp = sp;
     av_extend(curstack, (p - stack_base) + (n) + 128);
+#if defined(DEBUGGING) && !defined(USE_THREADS)
+    growing--;
+#endif
     return stack_sp;
 }
 
diff --git a/t/lib/tie-push.t b/t/lib/tie-push.t
new file mode 100755
index 0000000000..dd718deb14
--- /dev/null
+++ b/t/lib/tie-push.t
@@ -0,0 +1,24 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}    
+
+{
+ package Basic;
+ use Tie::Array;
+ @ISA = qw(Tie::Array);
+
+ sub TIEARRAY  { return bless [], shift }
+ sub FETCH     { $_[0]->[$_[1]] }
+ sub STORE     { $_[0]->[$_[1]] = $_[2] }
+ sub FETCHSIZE { scalar(@{$_[0]}) }
+ sub STORESIZE { $#{$_[0]} = $_[1]-1 }
+}
+
+tie @x,Basic;
+tie @get,Basic;
+tie @got,Basic;
+tie @tests,Basic;
+require "../t/op/push.t"
diff --git a/t/lib/tie-stdarray.t b/t/lib/tie-stdarray.t
new file mode 100755
index 0000000000..7ca4d76f11
--- /dev/null
+++ b/t/lib/tie-stdarray.t
@@ -0,0 +1,12 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Tie::Array;
+tie @foo,Tie::StdArray;
+tie @ary,Tie::StdArray;
+tie @bar,Tie::StdArray;
+require "../t/op/array.t"
diff --git a/t/lib/tie-stdpush.t b/t/lib/tie-stdpush.t
new file mode 100755
index 0000000000..34a69472f4
--- /dev/null
+++ b/t/lib/tie-stdpush.t
@@ -0,0 +1,10 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Tie::Array;
+tie @x,Tie::StdArray;
+require "../t/op/push.t"
diff --git a/t/op/avhv.t b/t/op/avhv.t
index 0390429d2b..a7ce58ab87 100755
--- a/t/op/avhv.t
+++ b/t/op/avhv.t
@@ -1,13 +1,23 @@
 #!./perl
+      
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+require Tie::Array;
 
-package Tie::StdArray;
+package Tie::BasicArray;
+@ISA = 'Tie::Array';
 sub TIEARRAY  { bless [], $_[0] }
-sub STORE    { $_[0]->[$_[1]] = $_[2] }
-sub FETCH    { $_[0]->[$_[1]] }
+sub STORE     { $_[0]->[$_[1]] = $_[2] }
+sub FETCH     { $_[0]->[$_[1]] }
+sub FETCHSIZE { scalar(@{$_[0]})} 
+sub STORESIZE { $#{$_[0]} = $_[1]+1 } 
 
 package main;
 
-print "1..4\n";
+print "1..5\n";
 
 $sch = {
     'abc' => 1,
@@ -48,12 +58,19 @@ $a->[0] = $sch;
 $a->{'abc'} = 'ABC';
 if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";}
 
+# quick check with tied array
+tie @fake, 'Tie::BasicArray';
+$a = \@fake;
+$a->[0] = $sch;
+
+$a->{'abc'} = 'ABC';
+if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";}
+
 # quick check with tied array & tied hash
-@INC = ("./lib", "../lib");
 require Tie::Hash;
 tie %fake, Tie::StdHash;
 %fake = %$sch;
 $a->[0] = \%fake;
 
 $a->{'abc'} = 'ABC';
-if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";}
+if ($a->{'abc'} eq 'ABC') {print "ok 5\n";} else {print "not ok 5\n";}
diff --git a/t/op/push.t b/t/op/push.t
index 68fab66af7..f62a4e9d8e 100755
--- a/t/op/push.t
+++ b/t/op/push.t
@@ -22,7 +22,7 @@ die "blech" unless @tests;
 @x = (1,2,3);
 push(@x,@x);
 if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
-push(x,4);
+push(@x,4);
 if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
 
 $test = 3;
@@ -47,3 +47,4 @@ foreach $line (@tests) {
     }
 }
 
+1;  # this file is require'd by lib/tie-stdpush.t
diff --git a/t/op/tiearray.t b/t/op/tiearray.t
index 045891dd42..da25760809 100755
--- a/t/op/tiearray.t
+++ b/t/op/tiearray.t
@@ -1,5 +1,6 @@
 #!./perl
 
+
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
@@ -20,7 +21,7 @@ sub STORESIZE
 {        
  $seen{'STORESIZE'}++;
  my ($ob,$sz) = @_; 
- return @$ob = $sz;
+ return $#{$ob} = $sz-1;
 }
 
 sub EXTEND
@@ -33,8 +34,7 @@ sub EXTEND
 sub FETCHSIZE
 {        
  $seen{'FETCHSIZE'}++;
- my ($ob) = @_; 
- return @$ob-1;
+ return scalar(@{$_[0]});
 }
 
 sub FETCH
@@ -54,7 +54,7 @@ sub STORE
 sub UNSHIFT
 {
  $seen{'UNSHIFT'}++;
- $ob = shift;
+ my $ob = shift;
  unshift(@$ob,@_);
 }                 
 
@@ -68,6 +68,12 @@ sub PUSH
 sub CLEAR
 {
  $seen{'CLEAR'}++;
+ @{$_[0]} = ();
+}
+
+sub DESTROY
+{
+ $seen{'DESTROY'}++;
 }
 
 sub POP
@@ -95,7 +101,7 @@ sub SPLICE
 
 package main;
 
-print "1..23\n";                   
+print "1..29\n";                   
 my $test = 1;
 
 {my @ary;
@@ -154,8 +160,6 @@ print "ok ", $test++,"\n";
 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;
@@ -163,21 +167,35 @@ print "ok ", $test++,"\n";
 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";         
+  
+my $t = 0;
+foreach $n (@ary)
+ {
+  print "not " unless $n == ++$t;
+  print "ok ", $test++,"\n";         
+ }
+
+@ary = qw(3 2 1);
+print "not " unless join(':',@ary) eq '3:2:1';
+print "ok ", $test++,"\n";         
 
-# untie @ary;   
+untie @ary;   
 
 }
-
+                           
+print "not " unless $seen{'DESTROY'} == 1;
+print "ok ", $test++,"\n";