From 746f6409435f8adf48a22fa3c61d95758160b655 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 24 Dec 2011 07:05:42 -0800
Subject: [PATCH] =?utf8?q?Don=E2=80=99t=20crash=20when=20writing=20to=20nu?=
 =?utf8?q?ll=20hash=20elem?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

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.
---
 ext/XS-APItest/t/hash.t | 13 +++++++++++++
 pp.c                    |  4 ++--
 pp_hot.c                |  4 ++--
 3 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/ext/XS-APItest/t/hash.t b/ext/XS-APItest/t/hash.t
index f66edfa..06983c5 100644
--- 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
--- 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
--- 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
-- 
2.7.4