diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-12-20 15:25:18 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-12-20 15:25:47 -0800 |
commit | 95cf23680e00af63884a0f886d7434eb1b930377 (patch) | |
tree | 67317e91948f36bc57470452d34a92d33e6ef849 /hv.c | |
parent | 489db6ed0dd2b337d56c1c9625815cc725e7af82 (diff) | |
download | perl-95cf23680e00af63884a0f886d7434eb1b930377.tar.gz |
[perl #106282] Don’t crash cloning tied %^H
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.
Diffstat (limited to 'hv.c')
-rw-r--r-- | hv.c | 2 |
1 files changed, 1 insertions, 1 deletions
@@ -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), |