diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2011-12-24 07:05:42 -0800 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-12-24 16:14:31 -0800 |
| commit | 746f6409435f8adf48a22fa3c61d95758160b655 (patch) | |
| tree | 2e01962418518b71f6d2a56e7a5fc25a2662a944 | |
| parent | 3f4d1d7873e4e02f3801f2982565de93d2127bbd (diff) | |
| download | perl-746f6409435f8adf48a22fa3c61d95758160b655.tar.gz | |
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.
| -rw-r--r-- | ext/XS-APItest/t/hash.t | 13 | ||||
| -rw-r--r-- | pp.c | 4 | ||||
| -rw-r--r-- | 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 f66edfa1f5..06983c570d 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; @@ -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; @@ -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 |