This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make exists() work better on pseudo-hashes (reworked a patch suggested
authorGurusamy Sarathy <gsar@cpan.org>
Sat, 2 Oct 1999 03:36:41 +0000 (03:36 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Sat, 2 Oct 1999 03:36:41 +0000 (03:36 +0000)
by Michael G Schwern <schwern@pobox.com>)

p4raw-id: //depot/perl@4279

av.c
t/op/avhv.t

diff --git a/av.c b/av.c
index 509b897..7201b49 100644 (file)
--- 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);
 }
 
     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);
 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 *
 }
 
 HE *
index 6837127..92afa37 100755 (executable)
@@ -17,7 +17,7 @@ sub STORESIZE { $#{$_[0]} = $_[1]+1 }
 
 package main;
 
 
 package main;
 
-print "1..12\n";
+print "1..15\n";
 
 $sch = {
     'abc' => 1,
 
 $sch = {
     'abc' => 1,
@@ -108,3 +108,13 @@ f($a->{key});
 print "not " unless $a->[1] eq 'b';
 print "ok 12\n";
 
 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";