|
 |
de55dc7 |
From 59ef97c7af81ab6faba749d88b558a55da41c249 Mon Sep 17 00:00:00 2001
|
|
|
de55dc7 |
From: Zefram <zefram@fysh.org>
|
|
|
de55dc7 |
Date: Sun, 22 Jan 2017 07:26:34 +0000
|
|
|
de55dc7 |
Subject: [PATCH] fix special-case recreation of *::
|
|
|
de55dc7 |
MIME-Version: 1.0
|
|
|
de55dc7 |
Content-Type: text/plain; charset=UTF-8
|
|
|
de55dc7 |
Content-Transfer-Encoding: 8bit
|
|
|
de55dc7 |
|
|
|
de55dc7 |
Ported to 5.24.1:
|
|
|
de55dc7 |
|
|
|
de55dc7 |
commit 120921acd4cf27bb932a725a8cf5c957652b22eb
|
|
|
de55dc7 |
Author: Zefram <zefram@fysh.org>
|
|
|
de55dc7 |
Date: Sun Jan 22 07:26:34 2017 +0000
|
|
|
de55dc7 |
|
|
|
de55dc7 |
fix special-case recreation of *::
|
|
|
de55dc7 |
|
|
|
de55dc7 |
If *:: is called for then as a special case it is looked up as
|
|
|
de55dc7 |
$::{"main::"}. If $::{"main::"} has been deleted, then that hash entry
|
|
|
de55dc7 |
is recreated. But formerly it was only recreated as an undef scalar,
|
|
|
de55dc7 |
which broke things relying on glob lookup returning a glob. Now in
|
|
|
de55dc7 |
that special case the recreated hash entry is initialised as a glob,
|
|
|
de55dc7 |
and populated with the customary recursive reference to the main stash.
|
|
|
de55dc7 |
Fixes [perl #129869].
|
|
|
de55dc7 |
|
|
|
de55dc7 |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
de55dc7 |
---
|
|
|
de55dc7 |
gv.c | 11 +++++++++--
|
|
|
de55dc7 |
t/op/stash.t | 9 ++++++++-
|
|
|
de55dc7 |
2 files changed, 17 insertions(+), 3 deletions(-)
|
|
|
de55dc7 |
|
|
|
de55dc7 |
diff --git a/gv.c b/gv.c
|
|
|
de55dc7 |
index c89a3e7..3fda9b9 100644
|
|
|
de55dc7 |
--- a/gv.c
|
|
|
de55dc7 |
+++ b/gv.c
|
|
|
de55dc7 |
@@ -1642,8 +1642,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
|
|
|
de55dc7 |
name_cursor++;
|
|
|
de55dc7 |
*name = name_cursor+1;
|
|
|
de55dc7 |
if (*name == name_end) {
|
|
|
de55dc7 |
- if (!*gv)
|
|
|
de55dc7 |
- *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
|
|
|
de55dc7 |
+ if (!*gv) {
|
|
|
de55dc7 |
+ *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
|
|
|
de55dc7 |
+ if (SvTYPE(*gv) != SVt_PVGV) {
|
|
|
de55dc7 |
+ gv_init_pvn(*gv, PL_defstash, "main::", 6,
|
|
|
de55dc7 |
+ GV_ADDMULTI);
|
|
|
de55dc7 |
+ GvHV(*gv) =
|
|
|
de55dc7 |
+ MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
|
|
|
de55dc7 |
+ }
|
|
|
de55dc7 |
+ }
|
|
|
de55dc7 |
return TRUE;
|
|
|
de55dc7 |
}
|
|
|
de55dc7 |
}
|
|
|
de55dc7 |
diff --git a/t/op/stash.t b/t/op/stash.t
|
|
|
de55dc7 |
index 7ac379b..d6fded4 100644
|
|
|
de55dc7 |
--- a/t/op/stash.t
|
|
|
de55dc7 |
+++ b/t/op/stash.t
|
|
|
de55dc7 |
@@ -7,7 +7,7 @@ BEGIN {
|
|
|
de55dc7 |
|
|
|
de55dc7 |
BEGIN { require "./test.pl"; }
|
|
|
de55dc7 |
|
|
|
de55dc7 |
-plan( tests => 54 );
|
|
|
de55dc7 |
+plan( tests => 55 );
|
|
|
de55dc7 |
|
|
|
de55dc7 |
# Used to segfault (bug #15479)
|
|
|
de55dc7 |
fresh_perl_like(
|
|
|
de55dc7 |
@@ -355,3 +355,10 @@ is runperl(
|
|
|
de55dc7 |
),
|
|
|
de55dc7 |
"ok\n",
|
|
|
de55dc7 |
"[perl #128238] non-stashes in stashes";
|
|
|
de55dc7 |
+
|
|
|
de55dc7 |
+is runperl(
|
|
|
de55dc7 |
+ prog => '%:: = (); print *{q|::|}, qq|\n|',
|
|
|
de55dc7 |
+ stderr => 1,
|
|
|
de55dc7 |
+ ),
|
|
|
de55dc7 |
+ "*main::main::\n",
|
|
|
de55dc7 |
+ "[perl #129869] lookup %:: by name after clearing %::";
|
|
|
de55dc7 |
--
|
|
|
de55dc7 |
2.7.4
|
|
|
de55dc7 |
|