Join GitHub today
GitHub is home to over 50 million developers working together to host and review code, manage projects, and build software together.
Sign upsub prototypes not tracking refalias \&foo = \&bar #16987
Comments
From @jimavCreated by @jimavThis is a bug report for perl from jim.avera@gmail.com, ----------------------------------------------------------------- The refalias In subsequently-compiled code, the compiler still wants calls #!/usr/bin/perl use feature 'refaliasing'; sub foo($$$$) { } BEGIN{ \&foo = \&bar; } foo(1); # Gets "Not enough arguments for main::foo" Perl Info |
From @tonycozOn Tue, 30 Apr 2019 16:50:20 -0700, jim.avera@gmail.com wrote:
It's worse than that: ./perl -Ilib -Mfeature=refaliasing -e 'sub foo { print "foo\n" } sub bar { print "bar\n" } \&foo = \&bar; $n = "foo"; &$n' It seems to be caused by the optimization of storing coderefs as GVs - pp_refassign is expecting a GV on the left for your sample code, but gets the CVref instead and so nothing happens: switch (left ? SvTYPE(left) : 0) { Tony |
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Tue, 30 Apr 2019 16:50:20 -0700, jim.avera@gmail.com wrote:
Fix attached. With the fix your code produces: $ ./perl -Ilib ../134072.pl Tony Tony |
From @tonycoz0001-perl-134072-allow-foo-bar-to-work-in-main.patchFrom 9b8b423a9084a4e7ed3f6b704a88801fca6ce555 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 15 May 2019 15:59:49 +1000
Subject: (perl #134072) allow \&foo = \&bar to work in main::
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.)
---
op.c | 9 +++++++++
t/op/lvref.t | 15 ++++++++++++++-
2 files changed, 23 insertions(+), 1 deletion(-)
diff --git a/op.c b/op.c
index 74761ca421..2e20dc886d 100644
--- a/op.c
+++ b/op.c
@@ -12465,7 +12465,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..b900cbc12a 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 somehow is only a problem in main::
+ 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.11.0
|
From @tonycozOn Tue, 14 May 2019 23:09:38 -0700, tonyc wrote:
Applied as 40258da. Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
Migrated from rt.perl.org#134072 (status was 'pending release')
Searchable as RT134072$