(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.)

diff --git a/op.c b/op.c
index f63eead..6ad1923 100644 (file)
--- 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) {
        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;
            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;
            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 3d5e952..3991a53 100644 (file)
--- 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");
 }
 
 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/,
 
 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)';
   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
 }
 
 # Mixed List Assignments