From 95cf23680e00af63884a0f886d7434eb1b930377 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 20 Dec 2011 15:25:18 -0800
Subject: =?UTF-8?q?[perl=20#106282]=20Don=E2=80=99t=20crash=20cloning=20ti?=
 =?UTF-8?q?ed=20%^H?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

When hv_iternext_flags is called on a tied hash, the hash entry (HE)
that it returns has no value.  Perl_hv_copy_hints_hv, added in commit
5b9c067131, was assuming that it would have a value and calling
sv_magic on it, resulting in a crash.

Commit b50b205 made namespace::clean’s test suite crash, because
strict.pm started using %^H.  It was already possible to crash
namespace::clean with other hh-using pragmata, like sort:

    # namespace::clean 0.21 only uses ties in the absence of B:H:EOS
    use Devel::Hide 'B::Hooks::EndOfScope';
    use sort "stable";
    use namespace::clean;
    use sort "stable";
    {;}

It was possible to trigger the crash with no modules like this:

    package namespace::clean::_TieHintHash;

    sub TIEHASH  { bless[] }
    sub STORE    { $_[0][0]{$_[1]} = $_[2] }
    sub FETCH    { $_[0][0]{$_[1]} }
    sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
    sub NEXTKEY  { each %{$_[0][0]} }

    package main;

    BEGIN {
	$^H{foo} = "bar";
	tie( %^H, 'namespace::clean::_TieHintHash' );
	$^H{foo} = "bar";
    }
    { ; }

This commit puts in a simple null check before calling sv_magic.  Tied
hint hashes still do not work, but they now only work as badly as in
5.8 (i.e., they don’t crash).

I don’t think tied hint hashes can ever be made to work properly, even
if we do make Perl_hv_copy_hints_hv copy the hash properly, because in
the scope where %^H is tied, the tie magic takes precedence over hint
magic, preventing the underlying he chain from being updated.  So
hints set in that scope will just not stick.
---
 hv.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'hv.c')

diff --git a/hv.c b/hv.c
index 27ce6a5759..7ce8048075 100644
--- a/hv.c
+++ b/hv.c
@@ -1465,7 +1465,7 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
 	while ((entry = hv_iternext_flags(ohv, 0))) {
 	    SV *const sv = newSVsv(HeVAL(entry));
 	    SV *heksv = newSVhek(HeKEY_hek(entry));
-	    sv_magic(sv, NULL, PERL_MAGIC_hintselem,
+	    if (sv) sv_magic(sv, NULL, PERL_MAGIC_hintselem,
 		     (char *)heksv, HEf_SVKEY);
 	    SvREFCNT_dec(heksv);
 	    (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
-- 
cgit v1.2.1