Fix subroutine protypes to track reference aliases
This commit is contained in:
parent
4298c8523d
commit
28b3f8c52b
|
@ -0,0 +1,84 @@
|
||||||
|
From 40258daf9899686d934c460ba3630431312d7694 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Tony Cook <tony@develop-help.com>
|
||||||
|
Date: Wed, 15 May 2019 15:59:49 +1000
|
||||||
|
Subject: [PATCH] (perl #134072) allow \&foo = \&bar to work in main::
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
subs in main:: are stored as a RV referring to a CV as a space
|
||||||
|
optimization, but the pp_refassign code expected to find a glob,
|
||||||
|
which made the assignment a no-op.
|
||||||
|
|
||||||
|
Fix this by upgrading the reference to a glob in the refassign check
|
||||||
|
function.
|
||||||
|
|
||||||
|
Note that this would be an issue in other packages if 1e2cfe157ca
|
||||||
|
was reverted (allowing the space savings in other packages too.)
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
op.c | 9 +++++++++
|
||||||
|
t/op/lvref.t | 15 ++++++++++++++-
|
||||||
|
2 files changed, 23 insertions(+), 1 deletion(-)
|
||||||
|
|
||||||
|
diff --git a/op.c b/op.c
|
||||||
|
index f63eeadc36..6ad192307f 100644
|
||||||
|
--- a/op.c
|
||||||
|
+++ b/op.c
|
||||||
|
@@ -12462,7 +12462,16 @@ Perl_ck_refassign(pTHX_ OP *o)
|
||||||
|
OP * const kid = cUNOPx(kidparent)->op_first;
|
||||||
|
o->op_private |= OPpLVREF_CV;
|
||||||
|
if (kid->op_type == OP_GV) {
|
||||||
|
+ SV *sv = (SV*)cGVOPx_gv(kid);
|
||||||
|
varop = kidparent;
|
||||||
|
+ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
|
||||||
|
+ /* a CVREF here confuses pp_refassign, so make sure
|
||||||
|
+ it gets a GV */
|
||||||
|
+ CV *const cv = (CV*)SvRV(sv);
|
||||||
|
+ SV *name_sv = sv_2mortal(newSVhek(CvNAME_HEK(cv)));
|
||||||
|
+ (void)gv_init_sv((GV*)sv, CvSTASH(cv), name_sv, 0);
|
||||||
|
+ assert(SvTYPE(sv) == SVt_PVGV);
|
||||||
|
+ }
|
||||||
|
goto detach_and_stack;
|
||||||
|
}
|
||||||
|
if (kid->op_type != OP_PADCV) goto bad;
|
||||||
|
diff --git a/t/op/lvref.t b/t/op/lvref.t
|
||||||
|
index 3d5e952fb0..3991a53780 100644
|
||||||
|
--- a/t/op/lvref.t
|
||||||
|
+++ b/t/op/lvref.t
|
||||||
|
@@ -1,10 +1,11 @@
|
||||||
|
+#!perl
|
||||||
|
BEGIN {
|
||||||
|
chdir 't';
|
||||||
|
require './test.pl';
|
||||||
|
set_up_inc("../lib");
|
||||||
|
}
|
||||||
|
|
||||||
|
-plan 164;
|
||||||
|
+plan 167;
|
||||||
|
|
||||||
|
eval '\$x = \$y';
|
||||||
|
like $@, qr/^Experimental aliasing via reference not enabled/,
|
||||||
|
@@ -291,6 +292,18 @@ package CodeTest {
|
||||||
|
my sub bs;
|
||||||
|
\(&cs) = expect_list_cx;
|
||||||
|
is \&cs, \&ThatSub, '\(&statesub)';
|
||||||
|
+
|
||||||
|
+ package main {
|
||||||
|
+ # this is only a problem in main:: due to 1e2cfe157ca
|
||||||
|
+ sub sx { "x" }
|
||||||
|
+ sub sy { "y" }
|
||||||
|
+ is sx(), "x", "check original";
|
||||||
|
+ my $temp = \&sx;
|
||||||
|
+ \&sx = \&sy;
|
||||||
|
+ is sx(), "y", "aliased";
|
||||||
|
+ \&sx = $temp;
|
||||||
|
+ is sx(), "x", "and restored";
|
||||||
|
+ }
|
||||||
|
}
|
||||||
|
|
||||||
|
# Mixed List Assignments
|
||||||
|
--
|
||||||
|
2.20.1
|
||||||
|
|
|
@ -183,6 +183,10 @@ Patch26: perl-5.31.0-perl-134048-prevent-an-erroneous-assertion-on-OP_SCA
|
||||||
# fixed after 5.31.0
|
# fixed after 5.31.0
|
||||||
Patch27: perl-5.31.0-perl-133913-limit-numeric-format-results-to-INT_MAX.patch
|
Patch27: perl-5.31.0-perl-133913-limit-numeric-format-results-to-INT_MAX.patch
|
||||||
|
|
||||||
|
# Fix subroutine protypes to track reference aliases, RT#134072,
|
||||||
|
# fixed after 5.31.0
|
||||||
|
Patch28: perl-5.31.0-perl-134072-allow-foo-bar-to-work-in-main.patch
|
||||||
|
|
||||||
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
|
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
|
||||||
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
|
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
|
||||||
|
|
||||||
|
@ -2728,6 +2732,7 @@ Perl extension for Version Objects
|
||||||
%patch25 -p1
|
%patch25 -p1
|
||||||
%patch26 -p1
|
%patch26 -p1
|
||||||
%patch27 -p1
|
%patch27 -p1
|
||||||
|
%patch28 -p1
|
||||||
%patch200 -p1
|
%patch200 -p1
|
||||||
%patch201 -p1
|
%patch201 -p1
|
||||||
|
|
||||||
|
@ -2762,6 +2767,7 @@ perl -x patchlevel.h \
|
||||||
'Fedora Patch25: Fix a crash with a negative precision in sprintf function (RT#134008)' \
|
'Fedora Patch25: Fix a crash with a negative precision in sprintf function (RT#134008)' \
|
||||||
'Fedora Patch26: Fix an erroneous assertion on OP_SCALAR (RT#134048)' \
|
'Fedora Patch26: Fix an erroneous assertion on OP_SCALAR (RT#134048)' \
|
||||||
'Fedora Patch27: Prevent from wrapping a width in a numeric format string (RT#133913)' \
|
'Fedora Patch27: Prevent from wrapping a width in a numeric format string (RT#133913)' \
|
||||||
|
'Fedora Patch28: Fix subroutine protypes to track reference aliases (RT#134072)' \
|
||||||
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
|
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
|
||||||
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
||||||
%{nil}
|
%{nil}
|
||||||
|
@ -5018,6 +5024,7 @@ popd
|
||||||
- Fix a crash with a negative precision in sprintf function (RT#134008)
|
- Fix a crash with a negative precision in sprintf function (RT#134008)
|
||||||
- Fix an erroneous assertion on OP_SCALAR (RT#134048)
|
- Fix an erroneous assertion on OP_SCALAR (RT#134048)
|
||||||
- Prevent from wrapping a width in a numeric format string (RT#133913)
|
- Prevent from wrapping a width in a numeric format string (RT#133913)
|
||||||
|
- Fix subroutine protypes to track reference aliases (RT#134072)
|
||||||
|
|
||||||
* Tue Jun 11 2019 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.30.0-439
|
* Tue Jun 11 2019 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.30.0-439
|
||||||
- Define %%perl_vendor*, %%perl_archlib, %%perl_privlib, because in rpm
|
- Define %%perl_vendor*, %%perl_archlib, %%perl_privlib, because in rpm
|
||||||
|
|
Loading…
Reference in New Issue