[perl #99142] Make GV_ADDMG and magic vars account for s(t)ubs
authorFather Chrysostomos <sprout@cpan.org>
Fri, 16 Sep 2011 00:56:30 +0000 (17:56 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 16 Sep 2011 00:56:54 +0000 (17:56 -0700)
When I eliminated is_gv_magical_sv (commit 23496c6ea), I did not take
into account that existing symbol table elements might not be GVs.
The special handling that GV_ADDMG does (to avoid creating a GV at all
unless a magical variable is created) simply does not apply if there
is a stash element there already, so this commit disables it.

The special handling involves creating a GV without assigning it to
the symbol table until the end of the function, where it gets freed if
it turns out not to contain a magical variable.  If the GV it is deal-
ing with is actually a non-GV that was residing in a stash element,
then we end up freeing something still in use.

When I made defined(&{"name"}) vivify CORE:: subs (commit 9da346da9),
this bug was extended to defined(&{"name"}), causing the
HTTP::MobileAttribute failure reported in the RT ticket (which was
actually triggered directly by code in Class::Inspector, but which
required HTTP::MobileAttribute’s test suite to make it apparent).

gv.c
t/op/gv.t

diff --git a/gv.c b/gv.c
index 116d391..720ba6b 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1255,7 +1255,10 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        if (addmg) gv = (GV *)newSV(0);
        else return NULL;
     }
-    else gv = *gvp;
+    else gv = *gvp, addmg = 0;
+    /* From this point on, addmg means gv has not been inserted in the
+       symtab yet. */
+
     if (SvTYPE(gv) == SVt_PVGV) {
        if (add) {
            GvMULTI_on(gv);
index d191323..8c0e311 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan( tests => 236 );
+plan( tests => 238 );
 
 # type coercion on assignment
 $foo = 'foo';
@@ -906,6 +906,16 @@ eval { *{;undef} = 3 };
 like $@, qr/^Can't use an undefined value as a symbol reference at /,
   '*{ ;undef } assignment';
 
+# [perl #99142] defined &{"foo"} when there is a constant stub
+# If I break your module, you get to have it mentioned in Perl's tests. :-)
+package HTTP::MobileAttribute::Plugin::Locator {
+    use constant LOCATOR_GPS => 1;
+    ::ok defined &{__PACKAGE__."::LOCATOR_GPS"},
+        'defined &{"name of constant"}';
+    ::ok Internals::SvREFCNT(${__PACKAGE__."::"}{LOCATOR_GPS}),
+       "stash elem for slot is not freed prematurely";
+}
+
 __END__
 Perl
 Rules