diff options
| -rw-r--r-- | hv.c | 2 | ||||
| -rw-r--r-- | t/comp/hints.t | 27 |
2 files changed, 26 insertions, 3 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), diff --git a/t/comp/hints.t b/t/comp/hints.t index 7796727aee..b70f15eab1 100644 --- a/t/comp/hints.t +++ b/t/comp/hints.t @@ -6,7 +6,7 @@ BEGIN { @INC = qw(. ../lib); } -BEGIN { print "1..24\n"; } +BEGIN { print "1..25\n"; } BEGIN { print "not " if exists $^H{foo}; print "ok 1 - \$^H{foo} doesn't exist initially\n"; @@ -128,6 +128,29 @@ BEGIN { "ok 23 - \$^H{foo} correct after /unicode/i (res=$res)\n"; } +# [perl #106282] Crash when tying %^H +# Tying %^H does not and cannot work, but it should not crash. +eval q` + # Do something naughty enough, and you get your module mentioned in the + # test suite. :-) + 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"; # activate localisation magic + tie( %^H, 'namespace::clean::_TieHintHash' ); # sabotage %^H + $^H{foo} = "bar"; # create an element in the tied hash + } + { ; } # clone the tied hint hash +`; +print "ok 24 - no crash when cloning a tied hint hash\n"; # Add new tests above this require, in case it fails. @@ -139,7 +162,7 @@ my $result = runperl( stderr => 1 ); print "not " if length $result; -print "ok 24 - double-freeing hints hash\n"; +print "ok 25 - double-freeing hints hash\n"; print "# got: $result\n" if length $result; __END__ |