support delete() and exists() on array, tied array, and pseudo-hash

elements or slices

p4raw-id: //depot/perl@4796

17 files changed, 415 insertions, 72 deletions

diff --git a/av.c b/av.c
index 8f3b4f8bda..3b7e81338a 100644
--- a/av.c
+++ b/av.c
@@ -591,6 +591,83 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
 	(void)av_store(av,fill,&PL_sv_undef);
 }
 
+SV *
+Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
+{
+    SV *sv;
+
+    if (!av)
+	return Nullsv;
+    if (SvREADONLY(av))
+	Perl_croak(aTHX_ PL_no_modify);
+    if (key < 0) {
+	key += AvFILL(av) + 1;
+	if (key < 0)
+	    return Nullsv;
+    }
+    if (SvRMAGICAL(av)) {
+	SV **svp;
+	if ((mg_find((SV*)av,'P') || mg_find((SV*)av,'D'))
+	    && (svp = av_fetch(av, key, TRUE)))
+	{
+	    sv = *svp;
+	    mg_clear(sv);
+	    if (mg_find(sv, 'p')) {
+		sv_unmagic(sv, 'p');		/* No longer an element */
+		return sv;
+	    }
+	    return Nullsv;			/* element cannot be deleted */
+	}
+    }
+    if (key > AvFILLp(av))
+	return Nullsv;
+    else {
+	sv = AvARRAY(av)[key];
+	if (key == AvFILLp(av)) {
+	    do {
+		AvFILLp(av)--;
+	    } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
+	}
+	else
+	    AvARRAY(av)[key] = &PL_sv_undef;
+	if (SvSMAGICAL(av))
+	    mg_set((SV*)av);
+    }
+    if (flags & G_DISCARD) {
+	SvREFCNT_dec(sv);
+	sv = Nullsv;
+    }
+    return sv;
+}
+
+/*
+ * This relies on the fact that uninitialized array elements
+ * are set to &PL_sv_undef.
+ */
+
+bool
+Perl_av_exists(pTHX_ AV *av, I32 key)
+{
+    if (!av)
+	return FALSE;
+    if (key < 0) {
+	key += AvFILL(av) + 1;
+	if (key < 0)
+	    return FALSE;
+    }
+    if (SvRMAGICAL(av)) {
+	if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) {
+	    SV *sv = sv_newmortal();
+	    mg_copy((SV*)av, sv, 0, key);
+	    magic_existspack(sv, mg_find(sv, 'p'));
+	    return SvTRUE(sv);
+	}
+    }
+    if (av_fetch(av, key, 0))
+	return TRUE;
+    else
+	return FALSE;
+}
 
 /* AVHV: Support for treating arrays as if they were hashes.  The
  * first element of the array should be a hash reference that maps
@@ -638,34 +715,33 @@ Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
     return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
 }
 
+SV *
+Perl_avhv_delete_ent(pTHX_ AV *av, SV *keysv, I32 flags, U32 hash)
+{
+    HV *keys = avhv_keys(av);
+    HE *he;
+	
+    he = hv_fetch_ent(keys, keysv, FALSE, hash);
+    if (!he || !SvOK(HeVAL(he)))
+	return Nullsv;
+
+    return av_delete(av, avhv_index_sv(HeVAL(he)), flags);
+}
+
 /* Check for the existence of an element named by a given key.
  *
- * This relies on the fact that uninitialized array elements
- * are set to &PL_sv_undef.
  */
 bool
 Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
 {
     HV *keys = avhv_keys(av);
     HE *he;
-    IV ix;
 	
     he = hv_fetch_ent(keys, keysv, FALSE, hash);
     if (!he || !SvOK(HeVAL(he)))
 	return FALSE;
 
-    ix = SvIV(HeVAL(he));
-
-    /* If the array hasn't been extended to reach the key yet then
-     * it hasn't been accessed and thus does not exist.  We use
-     * AvFILL() rather than AvFILLp() to handle tied av. */
-    if (ix > 0 && ix <= AvFILL(av)
-	&& (SvRMAGICAL(av)
-	    || (AvARRAY(av)[ix] && AvARRAY(av)[ix] != &PL_sv_undef)))
-    {
-	return TRUE;
-    }
-    return FALSE;
+    return av_exists(av, avhv_index_sv(HeVAL(he)));
 }
 
 HE *
diff --git a/embed.h b/embed.h
index 3b5c0bfa21..27685ff2ed 100644
--- a/embed.h
+++ b/embed.h
@@ -67,12 +67,15 @@
 #define append_elem		Perl_append_elem
 #define append_list		Perl_append_list
 #define apply			Perl_apply
+#define avhv_delete_ent		Perl_avhv_delete_ent
 #define avhv_exists_ent		Perl_avhv_exists_ent
 #define avhv_fetch_ent		Perl_avhv_fetch_ent
 #define avhv_iternext		Perl_avhv_iternext
 #define avhv_iterval		Perl_avhv_iterval
 #define avhv_keys		Perl_avhv_keys
 #define av_clear		Perl_av_clear
+#define av_delete		Perl_av_delete
+#define av_exists		Perl_av_exists
 #define av_extend		Perl_av_extend
 #define av_fake			Perl_av_fake
 #define av_fetch		Perl_av_fetch
@@ -1502,12 +1505,15 @@
 #define append_elem(a,b,c)	Perl_append_elem(aTHX_ a,b,c)
 #define append_list(a,b,c)	Perl_append_list(aTHX_ a,b,c)
 #define apply(a,b,c)		Perl_apply(aTHX_ a,b,c)
+#define avhv_delete_ent(a,b,c,d)	Perl_avhv_delete_ent(aTHX_ a,b,c,d)
 #define avhv_exists_ent(a,b,c)	Perl_avhv_exists_ent(aTHX_ a,b,c)
 #define avhv_fetch_ent(a,b,c,d)	Perl_avhv_fetch_ent(aTHX_ a,b,c,d)
 #define avhv_iternext(a)	Perl_avhv_iternext(aTHX_ a)
 #define avhv_iterval(a,b)	Perl_avhv_iterval(aTHX_ a,b)
 #define avhv_keys(a)		Perl_avhv_keys(aTHX_ a)
 #define av_clear(a)		Perl_av_clear(aTHX_ a)
+#define av_delete(a,b,c)	Perl_av_delete(aTHX_ a,b,c)
+#define av_exists(a,b)		Perl_av_exists(aTHX_ a,b)
 #define av_extend(a,b)		Perl_av_extend(aTHX_ a,b)
 #define av_fake(a,b)		Perl_av_fake(aTHX_ a,b)
 #define av_fetch(a,b,c)		Perl_av_fetch(aTHX_ a,b,c)
@@ -2919,6 +2925,8 @@
 #define append_list		Perl_append_list
 #define Perl_apply		CPerlObj::Perl_apply
 #define apply			Perl_apply
+#define Perl_avhv_delete_ent	CPerlObj::Perl_avhv_delete_ent
+#define avhv_delete_ent		Perl_avhv_delete_ent
 #define Perl_avhv_exists_ent	CPerlObj::Perl_avhv_exists_ent
 #define avhv_exists_ent		Perl_avhv_exists_ent
 #define Perl_avhv_fetch_ent	CPerlObj::Perl_avhv_fetch_ent
@@ -2931,6 +2939,10 @@
 #define avhv_keys		Perl_avhv_keys
 #define Perl_av_clear		CPerlObj::Perl_av_clear
 #define av_clear		Perl_av_clear
+#define Perl_av_delete		CPerlObj::Perl_av_delete
+#define av_delete		Perl_av_delete
+#define Perl_av_exists		CPerlObj::Perl_av_exists
+#define av_exists		Perl_av_exists
 #define Perl_av_extend		CPerlObj::Perl_av_extend
 #define av_extend		Perl_av_extend
 #define Perl_av_fake		CPerlObj::Perl_av_fake
diff --git a/embed.pl b/embed.pl
index 2265901cbd..84d689e3b8 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1084,12 +1084,15 @@ p	|bool	|Gv_AMupdate	|HV* stash
 p	|OP*	|append_elem	|I32 optype|OP* head|OP* tail
 p	|OP*	|append_list	|I32 optype|LISTOP* first|LISTOP* last
 p	|I32	|apply		|I32 type|SV** mark|SV** sp
+p	|SV*	|avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash
 p	|bool	|avhv_exists_ent|AV *ar|SV* keysv|U32 hash
 p	|SV**	|avhv_fetch_ent	|AV *ar|SV* keysv|I32 lval|U32 hash
 p	|HE*	|avhv_iternext	|AV *ar
 p	|SV*	|avhv_iterval	|AV *ar|HE* entry
 p	|HV*	|avhv_keys	|AV *ar
 p	|void	|av_clear	|AV* ar
+p	|SV*	|av_delete	|AV* ar|I32 key|I32 flags
+p	|bool	|av_exists	|AV* ar|I32 key
 p	|void	|av_extend	|AV* ar|I32 key
 p	|AV*	|av_fake	|I32 size|SV** svp
 p	|SV**	|av_fetch	|AV* ar|I32 key|I32 lval
diff --git a/global.sym b/global.sym
index 41993281dd..0fc9739a73 100644
--- a/global.sym
+++ b/global.sym
@@ -23,12 +23,15 @@ Perl_Gv_AMupdate
 Perl_append_elem
 Perl_append_list
 Perl_apply
+Perl_avhv_delete_ent
 Perl_avhv_exists_ent
 Perl_avhv_fetch_ent
 Perl_avhv_iternext
 Perl_avhv_iterval
 Perl_avhv_keys
 Perl_av_clear
+Perl_av_delete
+Perl_av_exists
 Perl_av_extend
 Perl_av_fake
 Perl_av_fetch
diff --git a/lib/Tie/Array.pm b/lib/Tie/Array.pm
index 3f34c3b81f..5ef83c4781 100644
--- a/lib/Tie/Array.pm
+++ b/lib/Tie/Array.pm
@@ -1,7 +1,8 @@
 package Tie::Array;
 use vars qw($VERSION); 
 use strict;
-$VERSION = '1.00';
+use Carp;
+$VERSION = '1.01';
 
 # Pod documentation after __END__ below.
 
@@ -74,6 +75,16 @@ sub SPLICE
  return @result;
 } 
 
+sub EXISTS {
+    my $pkg = ref $_[0];
+    croak "$pkg dosn't define an EXISTS method";
+}
+
+sub DELETE {
+    my $pkg = ref $_[0];
+    croak "$pkg dosn't define a DELETE method";
+}
+
 package Tie::StdArray;
 use vars qw(@ISA);
 @ISA = 'Tie::Array';
@@ -88,6 +99,8 @@ sub POP       { pop(@{$_[0]}) }
 sub PUSH      { my $o = shift; push(@$o,@_) }
 sub SHIFT     { shift(@{$_[0]}) } 
 sub UNSHIFT   { my $o = shift; unshift(@$o,@_) } 
+sub EXISTS    { exists $_[0]->[$_[1]] }
+sub DELETE    { delete $_[0]->[$_[1]] }
 
 sub SPLICE
 {
@@ -120,6 +133,8 @@ Tie::Array - base class for tied arrays
         
     sub STORE { ... }        # mandatory if elements writeable
     sub STORESIZE { ... }    # mandatory if elements can be added/deleted
+    sub EXISTS { ... }       # mandatory if exists() expected to work
+    sub DELETE { ... }       # mandatory if delete() expected to work
                                
     # optional methods - for efficiency
     sub CLEAR { ... }  
@@ -150,9 +165,11 @@ Tie::Array - base class for tied arrays
 
 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>, 
+to a package. The basic B<Tie::Array> package provides stub C<DESTROY>,
+and C<EXTEND> methods that do nothing, stub C<DELETE> and C<EXISTS>
+methods that croak() if the delete() or exists() builtins are ever called
+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 
@@ -203,6 +220,18 @@ deleted.
 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 EXISTS this, key
+
+Verify that the element at index I<key> exists in the tied array I<this>.
+
+The B<Tie::Array> implementation is a stub that simply croaks.
+
+=item DELETE this, key
+
+Delete the element at index I<key> from the tied array I<this>.
+
+The B<Tie::Array> implementation is a stub that simply croaks.
+
 =item CLEAR this
 
 Clear (remove, delete, ...) all values from the tied array associated with
diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm
index 2902efb4d0..928b798e45 100644
--- a/lib/Tie/Hash.pm
+++ b/lib/Tie/Hash.pm
@@ -73,6 +73,8 @@ Return the next key for the hash.
 
 Verify that I<key> exists with the tied hash I<this>.
 
+The B<Tie::Hash> implementation is a stub that simply croaks.
+
 =item DELETE this, key
 
 Delete the key I<key> from the tied hash I<this>.
diff --git a/objXSUB.h b/objXSUB.h
index 56895c52e3..035367d417 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -851,6 +851,10 @@
 #define Perl_apply		pPerl->Perl_apply
 #undef  apply
 #define apply			Perl_apply
+#undef  Perl_avhv_delete_ent
+#define Perl_avhv_delete_ent	pPerl->Perl_avhv_delete_ent
+#undef  avhv_delete_ent
+#define avhv_delete_ent		Perl_avhv_delete_ent
 #undef  Perl_avhv_exists_ent
 #define Perl_avhv_exists_ent	pPerl->Perl_avhv_exists_ent
 #undef  avhv_exists_ent
@@ -875,6 +879,14 @@
 #define Perl_av_clear		pPerl->Perl_av_clear
 #undef  av_clear
 #define av_clear		Perl_av_clear
+#undef  Perl_av_delete
+#define Perl_av_delete		pPerl->Perl_av_delete
+#undef  av_delete
+#define av_delete		Perl_av_delete
+#undef  Perl_av_exists
+#define Perl_av_exists		pPerl->Perl_av_exists
+#undef  av_exists
+#define av_exists		Perl_av_exists
 #undef  Perl_av_extend
 #define Perl_av_extend		pPerl->Perl_av_extend
 #undef  av_extend
diff --git a/op.c b/op.c
index 383e91750a..805aeaac8e 100644
--- a/op.c
+++ b/op.c
@@ -4921,11 +4921,22 @@ Perl_ck_delete(pTHX_ OP *o)
     o->op_private = 0;
     if (o->op_flags & OPf_KIDS) {
 	OP *kid = cUNOPo->op_first;
-	if (kid->op_type == OP_HSLICE)
+	switch (kid->op_type) {
+	case OP_ASLICE:
+	    o->op_flags |= OPf_SPECIAL;
+	    /* FALL THROUGH */
+	case OP_HSLICE:
 	    o->op_private |= OPpSLICE;
-	else if (kid->op_type != OP_HELEM)
-	    Perl_croak(aTHX_ "%s argument is not a HASH element or slice",
+	    break;
+	case OP_AELEM:
+	    o->op_flags |= OPf_SPECIAL;
+	    /* FALL THROUGH */
+	case OP_HELEM:
+	    break;
+	default:
+	    Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice",
 		  PL_op_desc[o->op_type]);
+	}
 	null(kid);
     }
     return o;
@@ -5011,8 +5022,11 @@ Perl_ck_exists(pTHX_ OP *o)
     o = ck_fun(o);
     if (o->op_flags & OPf_KIDS) {
 	OP *kid = cUNOPo->op_first;
-	if (kid->op_type != OP_HELEM)
-	    Perl_croak(aTHX_ "%s argument is not a HASH element", PL_op_desc[o->op_type]);
+	if (kid->op_type == OP_AELEM)
+	    o->op_flags |= OPf_SPECIAL;
+	else if (kid->op_type != OP_HELEM)
+	    Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
+		       PL_op_desc[o->op_type]);
 	null(kid);
     }
     return o;
diff --git a/perlapi.c b/perlapi.c
index d0f8a4ff47..589d8b614e 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -91,6 +91,13 @@ Perl_apply(pTHXo_ I32 type, SV** mark, SV** sp)
     return ((CPerlObj*)pPerl)->Perl_apply(type, mark, sp);
 }
 
+#undef  Perl_avhv_delete_ent
+SV*
+Perl_avhv_delete_ent(pTHXo_ AV *ar, SV* keysv, I32 flags, U32 hash)
+{
+    return ((CPerlObj*)pPerl)->Perl_avhv_delete_ent(ar, keysv, flags, hash);
+}
+
 #undef  Perl_avhv_exists_ent
 bool
 Perl_avhv_exists_ent(pTHXo_ AV *ar, SV* keysv, U32 hash)
@@ -133,6 +140,20 @@ Perl_av_clear(pTHXo_ AV* ar)
     ((CPerlObj*)pPerl)->Perl_av_clear(ar);
 }
 
+#undef  Perl_av_delete
+SV*
+Perl_av_delete(pTHXo_ AV* ar, I32 key, I32 flags)
+{
+    return ((CPerlObj*)pPerl)->Perl_av_delete(ar, key, flags);
+}
+
+#undef  Perl_av_exists
+bool
+Perl_av_exists(pTHXo_ AV* ar, I32 key)
+{
+    return ((CPerlObj*)pPerl)->Perl_av_exists(ar, key);
+}
+
 #undef  Perl_av_extend
 void
 Perl_av_extend(pTHXo_ AV* ar, I32 key)
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 47f7c26651..b205c7480c 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -425,6 +425,22 @@ This is rather similar to how the arrow may be omitted from
 C<$foo[10]->{'foo'}>.  Note however, that the arrow is still
 required for C<foo(10)->('bar')>.
 
+=head2 exists() and delete() are supported on array elements
+
+The exists() and delete() builtins now work on simple arrays as well.
+The behavior is similar to that on hash elements.
+
+exists() can be used to check whether an array element exists without
+autovivifying it.  If the array is tied, the EXISTS() method in the
+corresponding tied package will be invoked.
+
+delete() may now be used to remove an element from the array and return
+it.  If the element happens to be the one at the end, the size of the
+array also shrinks by one.  If the array is tied, the DELETE() method
+in the corresponding tied package will be invoked.
+
+See L<perlfunc/exists> and L<perlfunc/delete> for examples.
+
 =head2 syswrite() ease-of-use
 
 The length argument of C<syswrite()> has become optional.
@@ -812,6 +828,10 @@ been corrected.
 When applied to a pseudo-hash element, exists() now reports whether
 the specified value exists, not merely if the key is valid.
 
+delete() now works on pseudo-hashes.  When given a pseudo-hash element
+or slice it deletes the values corresponding to the keys (but not the keys
+themselves).  See L<perlref/"Pseudo-hashes: Using an array as a hash">.
+
 =head2 C<goto &sub> and AUTOLOAD
 
 The C<goto &sub> construct works correctly when C<&sub> happens
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 8928df128c..161ebaaf28 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -925,35 +925,52 @@ See also L</undef>, L</exists>, L</ref>.
 
 =item delete EXPR
 
-Deletes the specified key(s) and their associated values from a hash.
-For each key, returns the deleted value associated with that key, or
-the undefined value if there was no such key.  Deleting from C<$ENV{}>
-modifies the environment.  Deleting from a hash tied to a DBM file
-deletes the entry from the DBM file.  (But deleting from a C<tie>d hash
-doesn't necessarily return anything.)
+Given an expression that specifies a hash element, array element, hash slice,
+or array slice, deletes the specified element(s) from the hash or array.
+If the array elements happen to be at the end of the array, the size
+of the array will shrink by that number of elements.
 
-The following deletes all the values of a hash:
+Returns each element so deleted or the undefined value if there was no such
+element.  Deleting from C<$ENV{}> modifies the environment.  Deleting from
+a hash tied to a DBM file deletes the entry from the DBM file.  Deleting
+from a C<tie>d hash or array may not necessarily return anything.
+
+The following (inefficiently) deletes all the values of %HASH and @ARRAY:
 
     foreach $key (keys %HASH) {
 	delete $HASH{$key};
     }
 
-And so does this:
+    foreach $index (0 .. $#ARRAY) {
+	delete $ARRAY[$index];
+    }
+
+And so do these:
 
-    delete @HASH{keys %HASH}
+    delete @HASH{keys %HASH};
+
+    delete @ARRAY{0 .. $#ARRAY};
 
 But both of these are slower than just assigning the empty list
-or undefining it:
+or undefining %HASH or @ARRAY:
+
+    %HASH = ();		# completely empty %HASH
+    undef %HASH;	# forget %HASH ever existed
 
-    %hash = ();		# completely empty %hash
-    undef %hash;	# forget %hash every existed
+    @ARRAY = ();	# completely empty @ARRAY
+    undef @ARRAY;	# forget @ARRAY ever existed
 
 Note that the EXPR can be arbitrarily complicated as long as the final
-operation is a hash element lookup or hash slice:
+operation is a hash element, array element,  hash slice, or array slice
+lookup:
 
     delete $ref->[$x][$y]{$key};
     delete @{$ref->[$x][$y]}{$key1, $key2, @morekeys};
 
+    delete $ref->[$x][$y][$index];
+    delete @{$ref->[$x][$y]}[$index1, $index2, @moreindices];
+
+
 =item die LIST
 
 Outside an C<eval>, prints the value of LIST to C<STDERR> and
@@ -1386,27 +1403,36 @@ any C<DESTROY> methods in your objects.
 
 =item exists EXPR
 
-Returns true if the specified hash key exists in its hash, even
-if the corresponding value is undefined.
+Given an expression that specifies a hash element or array element,
+returns true if the specified element exists in the hash or array,
+even if the corresponding value is undefined.  The element is not
+autovivified if it doesn't exist.
 
-    print "Exists\n" 	if exists $array{$key};
-    print "Defined\n" 	if defined $array{$key};
-    print "True\n"      if $array{$key};
+    print "Exists\n" 	if exists $hash{$key};
+    print "Defined\n" 	if defined $hash{$key};
+    print "True\n"      if $hash{$key};
+
+    print "Exists\n" 	if exists $array[$index];
+    print "Defined\n" 	if defined $array[$index];
+    print "True\n"      if $array[$index];
 
 A hash element can be true only if it's defined, and defined if
 it exists, but the reverse doesn't necessarily hold true.
 
 Note that the EXPR can be arbitrarily complicated as long as the final
-operation is a hash key lookup:
+operation is a hash or array key lookup:
 
     if (exists $ref->{A}->{B}->{$key}) 	{ }
     if (exists $hash{A}{B}{$key}) 	{ }
 
-Although the last element will not spring into existence just because
-its existence was tested, intervening ones will.  Thus C<$ref-E<gt>{"A"}>
-and C<$ref-E<gt>{"A"}-E<gt>{"B"}> will spring into existence due to the
-existence test for a $key element.  This happens anywhere the arrow
-operator is used, including even 
+    if (exists $ref->{A}->{B}->[$ix]) 	{ }
+    if (exists $hash{A}{B}[$ix]) 	{ }
+
+Although the deepest nested array or hash will not spring into existence
+just because its existence was tested, any intervening ones will.
+Thus C<$ref-E<gt>{"A"}> and C<$ref-E<gt>{"A"}-E<gt>{"B"}> will spring
+into existence due to the existence test for the $key element above.
+This happens anywhere the arrow operator is used, including even:
 
     undef $ref;
     if (exists $ref->{"Some key"})	{ }
diff --git a/pod/perlref.pod b/pod/perlref.pod
index 12bc581a6d..f738399c9a 100644
--- a/pod/perlref.pod
+++ b/pod/perlref.pod
@@ -558,29 +558,39 @@ to array indices.  Here is an example:
        print "$k => $v\n";
    }
 
-Perl will raise an exception if you try to delete keys from a pseudo-hash
-or try to access nonexistent fields.  For better performance, Perl can also
+Perl will raise an exception if you try to access nonexistent fields.
+For better performance, Perl can also
 do the translation from field names to array indices at compile time for
 typed object references.  See L<fields>.
 
-There are two ways to check for the existance of a key in a
+There are two ways to check for the existence of a key in a
 pseudo-hash.  The first is to use exists().  This checks to see if the
-given field has been used yet.  It acts this way to match the behavior
+given field has ever been set.  It acts this way to match the behavior
 of a regular hash.  For instance:
 
 	$phash = [{foo =>1, bar => 2, pants => 3}, 'FOO'];
 	$phash->{pants} = undef;
 
-	exists $phash->{foo};    # true, 'foo' was set in the declaration
-	exists $phash->{bar};    # false, 'bar' has not been used.
-	exists $phash->{pants};  # true, your 'pants' have been touched
+	print exists $phash->{foo};    # true, 'foo' was set in the declaration
+	print exists $phash->{bar};    # false, 'bar' has not been used.
+	print exists $phash->{pants};  # true, your 'pants' have been touched
 
 The second is to use exists() on the hash reference sitting in the
 first array element.  This checks to see if the given key is a valid
 field in the pseudo-hash.
 
-	exists $phash->[0]{bar};	# true, 'bar' is a valid field
-	exists $phash->[0]{shoes};	# false, 'shoes' can't be used
+	print exists $phash->[0]{bar};	# true, 'bar' is a valid field
+	print exists $phash->[0]{shoes};# false, 'shoes' can't be used
+
+delete() on a pseudo-hash element only deletes the value corresponding
+to the key, not the key itself.  To delete the key, you'll have to
+explicitly delete it from the first hash element.
+
+	print delete $phash->{foo};     # prints $phash->[1], "FOO"
+	print exists $phash->{foo};     # false
+	print exists $phash->[0]{foo};  # true, key still exists
+	print delete $phash->[0]{foo};  # now key is gone
+	print $phash->{foo};            # runtime exception
 
 =head2 Function Templates
 
diff --git a/pod/perltie.pod b/pod/perltie.pod
index 5611174669..58e9c4375b 100644
--- a/pod/perltie.pod
+++ b/pod/perltie.pod
@@ -185,10 +185,12 @@ methods: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE and perhaps DESTROY.
 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.  
+The methods POP, PUSH, SHIFT, UNSHIFT, SPLICE, DELETE, and EXISTS 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 the first five of these in terms of the basic
+methods above.  The default implementations of DELETE and EXISTS in
+B<Tie::Array> simply C<croak>.
 
 In addition EXTEND will be called when perl would have pre-extended 
 allocation in a real array.
diff --git a/pp.c b/pp.c
index 7fc6b1a73b..c3874337e3 100644
--- a/pp.c
+++ b/pp.c
@@ -2647,13 +2647,28 @@ PP(pp_delete)
 	U32 hvtype;
 	hv = (HV*)POPs;
 	hvtype = SvTYPE(hv);
-	while (++MARK <= SP) {
-	    if (hvtype == SVt_PVHV)
+	if (hvtype == SVt_PVHV) {			/* hash element */
+	    while (++MARK <= SP) {
 		sv = hv_delete_ent(hv, *MARK, discard, 0);
-	    else
-		DIE(aTHX_ "Not a HASH reference");
-	    *MARK = sv ? sv : &PL_sv_undef;
+		*MARK = sv ? sv : &PL_sv_undef;
+	    }
 	}
+	else if (hvtype == SVt_PVAV) {
+	    if (PL_op->op_flags & OPf_SPECIAL) {	/* array element */
+		while (++MARK <= SP) {
+		    sv = av_delete((AV*)hv, SvIV(*MARK), discard);
+		    *MARK = sv ? sv : &PL_sv_undef;
+		}
+	    }
+	    else {					/* pseudo-hash element */
+		while (++MARK <= SP) {
+		    sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
+		    *MARK = sv ? sv : &PL_sv_undef;
+		}
+	    }
+	}
+	else
+	    DIE(aTHX_ "Not a HASH reference");
 	if (discard)
 	    SP = ORIGMARK;
 	else if (gimme == G_SCALAR) {
@@ -2667,6 +2682,12 @@ PP(pp_delete)
 	hv = (HV*)POPs;
 	if (SvTYPE(hv) == SVt_PVHV)
 	    sv = hv_delete_ent(hv, keysv, discard, 0);
+	else if (SvTYPE(hv) == SVt_PVAV) {
+	    if (PL_op->op_flags & OPf_SPECIAL)
+		sv = av_delete((AV*)hv, SvIV(keysv), discard);
+	    else
+		sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
+	}
 	else
 	    DIE(aTHX_ "Not a HASH reference");
 	if (!sv)
@@ -2687,7 +2708,11 @@ PP(pp_exists)
 	    RETPUSHYES;
     }
     else if (SvTYPE(hv) == SVt_PVAV) {
-	if (avhv_exists_ent((AV*)hv, tmpsv, 0))
+	if (PL_op->op_flags & OPf_SPECIAL) {		/* array element */
+	    if (av_exists((AV*)hv, SvIV(tmpsv)))
+		RETPUSHYES;
+	}
+	else if (avhv_exists_ent((AV*)hv, tmpsv, 0))	/* pseudo-hash element */
 	    RETPUSHYES;
     }
     else {
diff --git a/proto.h b/proto.h
index 4b991f83ba..36f4a40d36 100644
--- a/proto.h
+++ b/proto.h
@@ -59,12 +59,15 @@ PERL_CALLCONV bool	Perl_Gv_AMupdate(pTHX_ HV* stash);
 PERL_CALLCONV OP*	Perl_append_elem(pTHX_ I32 optype, OP* head, OP* tail);
 PERL_CALLCONV OP*	Perl_append_list(pTHX_ I32 optype, LISTOP* first, LISTOP* last);
 PERL_CALLCONV I32	Perl_apply(pTHX_ I32 type, SV** mark, SV** sp);
+PERL_CALLCONV SV*	Perl_avhv_delete_ent(pTHX_ AV *ar, SV* keysv, I32 flags, U32 hash);
 PERL_CALLCONV bool	Perl_avhv_exists_ent(pTHX_ AV *ar, SV* keysv, U32 hash);
 PERL_CALLCONV SV**	Perl_avhv_fetch_ent(pTHX_ AV *ar, SV* keysv, I32 lval, U32 hash);
 PERL_CALLCONV HE*	Perl_avhv_iternext(pTHX_ AV *ar);
 PERL_CALLCONV SV*	Perl_avhv_iterval(pTHX_ AV *ar, HE* entry);
 PERL_CALLCONV HV*	Perl_avhv_keys(pTHX_ AV *ar);
 PERL_CALLCONV void	Perl_av_clear(pTHX_ AV* ar);
+PERL_CALLCONV SV*	Perl_av_delete(pTHX_ AV* ar, I32 key, I32 flags);
+PERL_CALLCONV bool	Perl_av_exists(pTHX_ AV* ar, I32 key);
 PERL_CALLCONV void	Perl_av_extend(pTHX_ AV* ar, I32 key);
 PERL_CALLCONV AV*	Perl_av_fake(pTHX_ I32 size, SV** svp);
 PERL_CALLCONV SV**	Perl_av_fetch(pTHX_ AV* ar, I32 key, I32 lval);
diff --git a/t/op/avhv.t b/t/op/avhv.t
index 92afa37d37..23f9c69c8c 100755
--- a/t/op/avhv.t
+++ b/t/op/avhv.t
@@ -17,7 +17,7 @@ sub STORESIZE { $#{$_[0]} = $_[1]+1 }
 
 package main;
 
-print "1..15\n";
+print "1..20\n";
 
 $sch = {
     'abc' => 1,
@@ -118,3 +118,24 @@ print "not " unless exists $avhv->{pants};
 print "ok 14\n";
 print "not " if exists $avhv->{bar};
 print "ok 15\n";
+
+$avhv->{bar} = 10;
+print "not " unless exists $avhv->{bar} and $avhv->{bar} == 10;
+print "ok 16\n";
+
+$v = delete $avhv->{bar};
+print "not " unless $v == 10;
+print "ok 17\n";
+
+print "not " if exists $avhv->{bar};
+print "ok 18\n";
+
+$avhv->{foo} = 'xxx';
+$avhv->{bar} = 'yyy';
+$avhv->{pants} = 'zzz';
+@x = delete @{$avhv}{'foo','pants'};
+print "# @x\nnot " unless "@x" eq "xxx zzz";
+print "ok 19\n";
+
+print "not " unless "$avhv->{bar}" eq "yyy";
+print "ok 20\n";
diff --git a/t/op/delete.t b/t/op/delete.t
index 6452c35ded..10a218b1b6 100755
--- a/t/op/delete.t
+++ b/t/op/delete.t
@@ -1,6 +1,8 @@
 #!./perl
 
-print "1..17\n";
+print "1..36\n";
+
+# delete() on hash elements
 
 $foo{1} = 'a';
 $foo{2} = 'b';
@@ -11,7 +13,7 @@ $foo{5} = 'e';
 $foo = delete $foo{2};
 
 if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
-if ($foo{2} eq '') {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";}
+unless (exists $foo{2}) {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";}
 if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";}
 if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";}
 if ($foo{4} eq 'd') {print "ok 5\n";} else {print "not ok 5\n";}
@@ -22,8 +24,8 @@ if ($foo{5} eq 'e') {print "ok 6\n";} else {print "not ok 6\n";}
 if (@foo == 2) {print "ok 7\n";} else {print "not ok 7 ", @foo+0, "\n";}
 if ($foo[0] eq 'd') {print "ok 8\n";} else {print "not ok 8 ", $foo[0], "\n";}
 if ($foo[1] eq 'e') {print "ok 9\n";} else {print "not ok 9 ", $foo[1], "\n";}
-if ($foo{4} eq '') {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";}
-if ($foo{5} eq '') {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";}
+unless (exists $foo{4}) {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";}
+unless (exists $foo{5}) {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";}
 if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";}
 if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";}
 
@@ -57,3 +59,65 @@ print "@list" eq "foo" ? "ok 16\n" : "not ok 16 @list\n";
     print "not " unless $a == $b && $b == $c;
     print "ok 17\n";
 }
+
+# delete() on array elements
+
+@foo = ();
+$foo[1] = 'a';
+$foo[2] = 'b';
+$foo[3] = 'c';
+$foo[4] = 'd';
+$foo[5] = 'e';
+
+$foo = delete $foo[2];
+
+if ($foo eq 'b') {print "ok 18\n";} else {print "not ok 18 $foo\n";}
+unless (exists $foo[2]) {print "ok 19\n";} else {print "not ok 19 $foo[2]\n";}
+if ($foo[1] eq 'a') {print "ok 20\n";} else {print "not ok 20\n";}
+if ($foo[3] eq 'c') {print "ok 21\n";} else {print "not ok 21\n";}
+if ($foo[4] eq 'd') {print "ok 22\n";} else {print "not ok 22\n";}
+if ($foo[5] eq 'e') {print "ok 23\n";} else {print "not ok 23\n";}
+
+@bar = delete @foo[4,5];
+
+if (@bar == 2) {print "ok 24\n";} else {print "not ok 24 ", @bar+0, "\n";}
+if ($bar[0] eq 'd') {print "ok 25\n";} else {print "not ok 25 ", $bar[0], "\n";}
+if ($bar[1] eq 'e') {print "ok 26\n";} else {print "not ok 26 ", $bar[1], "\n";}
+unless (exists $foo[4]) {print "ok 27\n";} else {print "not ok 27 $foo[4]\n";}
+unless (exists $foo[5]) {print "ok 28\n";} else {print "not ok 28 $foo[5]\n";}
+if ($foo[1] eq 'a') {print "ok 29\n";} else {print "not ok 29\n";}
+if ($foo[3] eq 'c') {print "ok 30\n";} else {print "not ok 30\n";}
+
+$foo = join('',@foo);
+if ($foo eq 'ac') {print "ok 31\n";} else {print "not ok 31\n";}
+
+if (@foo == 4) {print "ok 32\n";} else {print "not ok 32\n";}
+
+foreach $key (0 .. $#foo) {
+    delete $foo[$key];
+}
+
+if (@foo == 0) {print "ok 33\n";} else {print "not ok 33\n";}
+
+$foo[0] = 'x';
+$foo[1] = 'y';
+
+$foo = "@foo";
+print +($foo eq 'x y') ? "ok 34\n" : "not ok 34\n";
+
+$refary[0]->[0] = "FOO";
+$refary[0]->[3] = "BAR";
+
+delete $refary[0]->[3];
+
+print @{$refary[0]} == 1 ? "ok 35\n" : "not ok 35 @list\n";
+
+{
+    my @a = 33;
+    my($a) = \(@a);
+    my $b = \$a[0];
+    my $c = \delete $a[bar];
+
+    print "not " unless $a == $b && $b == $c;
+    print "ok 36\n";
+}