From 2f222bbdd2d6da605708c3ab620ac25c62481179 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 28 Jul 2013 12:35:47 -0700
Subject: [PATCH] [perl #119051] Fix crash with \&$glob_copy
$ref = *Foo::nosub;
\&$ref;
The assignment creates a glob copy (coercible glob; one that down-
grades back to a simple scalar when assigned to).
\&$ref autovivifies a stub in that glob. The CvGV pointer ends up
pointing to $ref, rather than *Foo::nosub. $ref can easily cease
being a glob. So crashes happen.
Stub autovivification used to stringify the glob, look it up again by
name, and then vivify the stub in the glob.
In commit 186a5ba82d584 I removed what seemed like a waste of CPU
cycles, but apparently it served some purpose. The lookup caused CvGV
to point to *Foo::nosub, rather than $x.
This commit restores the stringfy-and-lookup if the glob is coercible
(SvFAKE). It goes a little further and turns off the SvFAKE flag if
the glob just looked up is also FAKE.
It turns out this bug is old, and has been triggerable via glob copies
in stash elements for a long time. 186a5ba82d584 made it easier to
trigger the bug (so it is a regression from 5.16).
---
op.c | 8 +++++++-
t/op/gv.t | 16 +++++++++++++++-
2 files changed, 22 insertions(+), 2 deletions(-)
diff --git a/op.c b/op.c
index e308d08..7576509 100644
--- a/op.c
+++ b/op.c
@@ -7918,13 +7918,19 @@ CV *
Perl_newSTUB(pTHX_ GV *gv, bool fake)
{
CV *cv = MUTABLE_CV(newSV_type(SVt_PVCV));
+ GV *cvgv;
PERL_ARGS_ASSERT_NEWSTUB;
assert(!GvCVu(gv));
GvCV_set(gv, cv);
GvCVGEN(gv) = 0;
if (!fake && HvENAME_HEK(GvSTASH(gv)))
gv_method_changed(gv);
- CvGV_set(cv, gv);
+ if (SvFAKE(gv)) {
+ cvgv = gv_fetchsv((SV *)gv, GV_ADDMULTI, SVt_PVCV);
+ SvFAKE_off(cvgv);
+ }
+ else cvgv = gv;
+ CvGV_set(cv, cvgv);
CvFILE_set_from_cop(cv, PL_curcop);
CvSTASH_set(cv, PL_curstash);
GvMULTI_on(gv);
diff --git a/t/op/gv.t b/t/op/gv.t
index deb92f3..806a68a 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
use warnings;
-plan( tests => 245 );
+plan( tests => 247 );
# type coercion on assignment
$foo = 'foo';
@@ -959,6 +959,20 @@ package lrcg {
$::{aoeuaoeuaoeaoeu} = __PACKAGE__; # cow
() = *{"aoeuaoeuaoeaoeu"};
+$x = *_119051;
+$y = \&$x;
+undef $x;
+eval { &$y };
+pass "No crash due to CvGV(vivified stub) pointing to flattened glob copy";
+# Not really supported, but this should not crash either:
+$x = *_119051again;
+delete $::{_119051again};
+$::{_119051again} = $x; # now we have a fake glob under the right name
+$y = \&$x; # so when this tries to look up the right GV for
+undef $::{_119051again}; # CvGV, it still gets a fake one
+eval { $y->() };
+pass "No crash due to CvGV pointing to glob copy in the stash";
+
__END__
Perl
Rules
--
1.8.3.1