From 5f93ebec860a92690d0bbb78cdecd46f32159a9d 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.)

Petr Písař: Ported to 5.28.2 from
40258daf9899686d934c460ba3630431312d7694.

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 9e2995b..cf90902 100644
--- a/op.c
+++ b/op.c
@@ -12361,7 +12361,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 28adc6a..91f2563 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 156;
+plan 159;
 
 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