This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix special-case recreation of *::
authorZefram <zefram@fysh.org>
Sun, 22 Jan 2017 07:26:34 +0000 (07:26 +0000)
committerZefram <zefram@fysh.org>
Sun, 22 Jan 2017 07:26:34 +0000 (07:26 +0000)
If *:: is called for then as a special case it is looked up as
$::{"main::"}.  If $::{"main::"} has been deleted, then that hash entry
is recreated.  But formerly it was only recreated as an undef scalar,
which broke things relying on glob lookup returning a glob.  Now in
that special case the recreated hash entry is initialised as a glob,
and populated with the customary recursive reference to the main stash.
Fixes [perl #129869].

gv.c
t/op/stash.t

diff --git a/gv.c b/gv.c
index fff8e95..ae800c9 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1663,8 +1663,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                 name_cursor++;
             *name = name_cursor+1;
             if (*name == name_end) {
                 name_cursor++;
             *name = name_cursor+1;
             if (*name == name_end) {
-                if (!*gv)
-                    *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
+                if (!*gv) {
+                   *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
+                   if (SvTYPE(*gv) != SVt_PVGV) {
+                       gv_init_pvn(*gv, PL_defstash, "main::", 6,
+                                   GV_ADDMULTI);
+                       GvHV(*gv) =
+                           MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
+                   }
+               }
                 return TRUE;
             }
         }
                 return TRUE;
             }
         }
index 8d2d628..c9634a3 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc( qw(../lib) );
 }
 
     set_up_inc( qw(../lib) );
 }
 
-plan( tests => 54 );
+plan( tests => 55 );
 
 # Used to segfault (bug #15479)
 fresh_perl_like(
 
 # Used to segfault (bug #15479)
 fresh_perl_like(
@@ -349,3 +349,10 @@ is runperl(
    ),
    "ok\n",
    "[perl #128238] non-stashes in stashes";
    ),
    "ok\n",
    "[perl #128238] non-stashes in stashes";
+
+is runperl(
+    prog => '%:: = (); print *{q|::|}, qq|\n|',
+    stderr => 1,
+   ),
+   "*main::main::\n",
+   "[perl #129869] lookup %:: by name after clearing %::";