Don’t crash when writing to null hash elem

It’s possible for XS code to create hash entries with null values.
pp_helem and pp_slice were not taking that into account.  In fact,
the core produces such hash entries, but they are rarely visible from
Perl.  It’s good to check for them anyway.

diff --git a/ext/XS-APItest/t/hash.t b/ext/XS-APItest/t/hash.t
index f66edfa..06983c5 100644 (file)
--- a/ext/XS-APItest/t/hash.t
+++ b/ext/XS-APItest/t/hash.t
@@ -245,6 +245,19 @@ sub test_precomputed_hashes {
       'newHVhv on tied hash';
 }
 
+# helem on entry with null value
+# This is actually a test for a Perl operator, not an XS API test.  But it
+# requires a hash that can only be produced by XS (although recently it
+# could be encountered when tying hint hashes).
+{
+    my %h;
+    fill_hash_with_nulls(\%h);
+    eval{ $h{84} = 1 };
+    pass 'no crash when writing to hash elem with null value';
+    eval{ @h{85} = 1 };
+    pass 'no crash when writing to hash elem with null value via slice';
+}
+
 done_testing;
 exit;
 

diff --git a/pp.c b/pp.c
index c9d72b8..dd67264 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4629,7 +4629,7 @@ PP(pp_hslice)
         svp = he ? &HeVAL(he) : NULL;
 
         if (lval) {
-            if (!svp || *svp == &PL_sv_undef) {
+            if (!svp || !*svp || *svp == &PL_sv_undef) {
                 DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
             }
             if (localizing) {
@@ -4642,7 +4642,7 @@ PP(pp_hslice)
                    SAVEHDELETE(hv, keysv);
             }
         }
-        *MARK = svp ? *svp : &PL_sv_undef;
+        *MARK = svp && *svp ? *svp : &PL_sv_undef;
     }
     if (GIMME != G_ARRAY) {
        MARK = ORIGMARK;

diff --git a/pp_hot.c b/pp_hot.c
index a2d6f91..99cd2e1 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1773,7 +1773,7 @@ PP(pp_helem)
     he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
     svp = he ? &HeVAL(he) : NULL;
     if (lval) {
-       if (!svp || *svp == &PL_sv_undef) {
+       if (!svp || !*svp || *svp == &PL_sv_undef) {
            SV* lv;
            SV* key2;
            if (!defer) {
@@ -1803,7 +1803,7 @@ PP(pp_helem)
            RETURN;
        }
     }
-    sv = (svp ? *svp : &PL_sv_undef);
+    sv = (svp && *svp ? *svp : &PL_sv_undef);
     /* Originally this did a conditional C<sv = sv_mortalcopy(sv)>; this
      * was to make C<local $tied{foo} = $tied{foo}> possible.
      * However, it seems no longer to be needed for that purpose, and