Globs that are in symbol table can be un-globbed

If a symbol table entry is undefined when a glob is assigned into it, it
gets a FAKE flag which makes it possible to be downgraded when non-glob
is subsequently assigned into it. It doesn't really matter, until we
decide to localize it -- it wouldn't be possible to restore its GP upon
context return if it changed type, therefore we must not do that.

This patch turns off FAKE flag when localizing a GV and restores it when
the context is left. A test case is included.

diff --git a/scope.c b/scope.c
index 6ee1254..6493933 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -281,7 +281,15 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
 
     PERL_ARGS_ASSERT_SAVE_GP;
 
-    save_pushptrptr(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP);
+    SSCHECK(4);
+    SSPUSHINT(SvFAKE(gv));
+    SSPUSHPTR(GvGP(gv));
+    SSPUSHPTR(SvREFCNT_inc(gv));
+    SSPUSHINT(SAVEt_GP);
+
+    /* Don't let the localized GV coerce into non-glob, otherwise we would
+     * not be able to restore GP upon leave from context if that happened */
+    SvFAKE_off(gv);
 
     if (empty) {
        GP *gp = Perl_newGP(aTHX_ gv);
@@ -812,10 +820,11 @@ Perl_leave_scope(pTHX_ I32 base)
            *(AV**)ptr = MUTABLE_AV(SSPOPPTR);
            break;
        case SAVEt_GP:                          /* scalar reference */
-           ptr = SSPOPPTR;
            gv = MUTABLE_GV(SSPOPPTR);
            gp_free(gv);
-           GvGP(gv) = (GP*)ptr;
+           GvGP(gv) = (GP*)SSPOPPTR;
+           if (SSPOPINT)
+               SvFAKE_on(gv);
             /* putting a method back into circulation ("local")*/
            if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvNAME_get(hv))
                 mro_method_changed_in(hv);

diff --git a/sv.c b/sv.c
index bc2450d..8179937 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -11581,12 +11581,13 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            TOPPTR(nss,ix) = pv_dup(c);
            break;
        case SAVEt_GP:                          /* scalar reference */
+           gv = (const GV *)POPPTR(ss,ix);
+           TOPPTR(nss,ix) = gv_dup_inc(gv, param);
            gp = (GP*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = gp = gp_dup(gp, param);
            (void)GpREFCNT_inc(gp);
-           gv = (const GV *)POPPTR(ss,ix);
-           TOPPTR(nss,ix) = gv_dup_inc(gv, param);
-            break;
+           TOPINT(nss,ix) = POPINT(ss,ix);
+           break;
        case SAVEt_FREEOP:
            ptr = POPPTR(ss,ix);
            if (ptr && (((OP*)ptr)->op_private & OPpREFCOUNTED)) {

diff --git a/t/op/gv.t b/t/op/gv.t
index 382e3f0..f3511e3 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 
 require './test.pl';
-plan( tests => 188 );
+plan( tests => 191 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -614,6 +614,15 @@ ok(exists($RT72740a::{s4}), "RT72740a::s4 exists");
 is(RT72740a::s1(), "RT72740b::s2", "RT72740::s1 parsed correctly");
 is(RT72740a::s3(), "RT72740b::s4", "RT72740::s3 parsed correctly");
 
+# [perl #71686] Globs that are in symbol table can be un-globbed
+$sym = undef;
+$::{fake} = *sym;
+is (eval 'local *::fake = \"chuck"; $fake', 'chuck',
+       "Localized glob didn't coerce into a RV");
+is ($@, '', "Can localize FAKE glob that's present in stash");
+is (scalar $::{fake}, "*main::sym",
+       "Localized FAKE glob's value was correctly restored");
+
 __END__
 Perl
 Rules