From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sat, 2 Oct 1999 03:36:41 +0000 (+0000)
Subject: make exists() work better on pseudo-hashes (reworked a patch suggested
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4bd46447950ba8dfb481e9515d0a88ed358d2013;p=p5sagit%2Fp5-mst-13.2.git

make exists() work better on pseudo-hashes (reworked a patch suggested
by Michael G Schwern <schwern@pobox.com>)

p4raw-id: //depot/perl@4279
---

diff --git a/av.c b/av.c
index 509b897..7201b49 100644
--- a/av.c
+++ b/av.c
@@ -637,11 +637,34 @@ Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
     return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
 }
 
+/* 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);
-    return hv_exists_ent(keys, keysv, hash);
+    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;
 }
 
 HE *
diff --git a/t/op/avhv.t b/t/op/avhv.t
index 6837127..92afa37 100755
--- a/t/op/avhv.t
+++ b/t/op/avhv.t
@@ -17,7 +17,7 @@ sub STORESIZE { $#{$_[0]} = $_[1]+1 }
 
 package main;
 
-print "1..12\n";
+print "1..15\n";
 
 $sch = {
     'abc' => 1,
@@ -108,3 +108,13 @@ f($a->{key});
 print "not " unless $a->[1] eq 'b';
 print "ok 12\n";
 
+# check if exists() is behaving properly
+$avhv = [{foo=>1,bar=>2,pants=>3}];
+print "not " if exists $avhv->{bar};
+print "ok 13\n";
+
+$avhv->{pants} = undef;
+print "not " unless exists $avhv->{pants};
+print "ok 14\n";
+print "not " if exists $avhv->{bar};
+print "ok 15\n";