In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e78862116af84a6ca22cd2ea66432fa8e52fde84?hp=c947b31cf1422f59c2ed95f6d3de272c2793a60c>
- Log ----------------------------------------------------------------- commit e78862116af84a6ca22cd2ea66432fa8e52fde84 Author: Father Chrysostomos <[email protected]> Date: Mon Jun 4 22:06:04 2012 -0700 [perl #113486] pp_ctl.c: Donât assume CopSTASH is a hash Calling HvNAME_HEK on something that is not a hash will result in a crash if it happens to have the SvOOK flag on, because then it tries to read to the end of HvARRAY, which may not even be a valid pointer. This can happen with this convoluted test case: { package foo; sub bar { main::bar() } } sub bar { delete $::{"foo::"}; my $x = \($1+2); my $y = \($1+2); # this is the one that reuses the mem addr, but my $z = \($1+2); # try the others just in case s/2// for $$x, $$y, $$z; # now SvOOK warn scalar caller }; foo::bar This commit only partially fixes ticket #113486, by eliminating the crash. We still have the problem of an unrelated stash reus- ing the SV. M pp_ctl.c M t/op/caller.t commit d0279c7ce493b7237b2f252043db1926615bc800 Author: Father Chrysostomos <[email protected]> Date: Mon Jun 4 20:36:39 2012 -0700 Fix bad assertions in pp_ctl.c:pp_caller If a stash is freed or undefined by code that it calls, then pp_caller can encounter a freed stash or nameless stash. HvNAME_HEK returns null for a freed scalar and for a hash without a name. So CopSTASHPV will also be null in that case, which is expected. If the hash is undefined, it may not be SvOOK any more, and if it is freed it defi- nitely wonât be. The following code *does* assume, however that CopSTASH is non-null, so assert that. M pp_ctl.c ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 7 ++++--- t/op/caller.t | 18 +++++++++++++++++- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index 2ccd812..e196022 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1891,9 +1891,10 @@ PP(pp_caller) } DEBUG_CX("CALLER"); - assert(CopSTASHPV(cx->blk_oldcop)); - assert(SvOOK((HV*)CopSTASH(cx->blk_oldcop))); - stash_hek = HvNAME_HEK((HV*)CopSTASH(cx->blk_oldcop)); + assert(CopSTASH(cx->blk_oldcop)); + stash_hek = SvTYPE(CopSTASH(cx->blk_oldcop)) == SVt_PVHV + ? HvNAME_HEK((HV*)CopSTASH(cx->blk_oldcop)) + : NULL; if (GIMME != G_ARRAY) { EXTEND(SP, 1); if (!stash_hek) diff --git a/t/op/caller.t b/t/op/caller.t index af73242..09d33f3 100644 --- a/t/op/caller.t +++ b/t/op/caller.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; - plan( tests => 85 ); + plan( tests => 86 ); } my @c; @@ -250,6 +250,22 @@ eval { sub { () = caller 0; } ->(1..3) }; untie @args; package main; +# [perl #113486] +fresh_perl_is <<'END', "ok\n", {}, + { package foo; sub bar { main::bar() } } + sub bar { + delete $::{"foo::"}; + my $x = \($1+2); + my $y = \($1+2); # this is the one that reuses the mem addr, but + my $z = \($1+2); # try the others just in case + s/2// for $$x, $$y, $$z; # now SvOOK + $x = caller; + print "ok\n"; +}; +foo::bar +END + "No crash when freed stash is reused for PV with offset hack"; + $::testing_caller = 1; do './op/caller.pl' or die $@; -- Perl5 Master Repository
