97 lines
2.8 KiB
Diff
97 lines
2.8 KiB
Diff
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
|
|
|