[perl #87388] bless[], "main::" crashes

As mention in the ticket, this was caused by b4dd662, which removed
‘dead’ code from gv_stashpvn:

commit b4dd66232df8f0d1c00796970dec7fc37fbe9edf
Author: Nicholas Clark <nick@ccl4.org>
Date:   Fri Oct 8 21:33:29 2010 +0100

    Remove dead code from Perl_gv_stashpvn().

    GvHV() and HvNAME() will both always already be set, as gv_fetchpvn_flags()
    will initialise these as it walks the string in its initial loop to locate the
    correct stash, then return early because name == name_end.

    This code has been dead since it was added in 5.000.

--- a/gv.c
+++ b/gv.c
@@ -927,11 +927,9 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
 	Safefree(tmpbuf);
     if (!tmpgv)
 	return NULL;
-    if (!GvHV(tmpgv))
-	GvHV(tmpgv) = newHV();
     stash = GvHV(tmpgv);
-    if (!HvNAME_get(stash))
-	hv_name_set(stash, name, namelen, 0);
+    assert(stash);
+    assert(HvNAME_get(stash));
     return stash;
 }

This routine, before the snippet shown, adds two colons to the end of
the name and then passes "main::::" to gv_fetch_pvn_flags.

gv_fetch_pvn_flags, when it parses a "::", sets the next subname to
point to the character after the second colon, and then continues
scanning from the next character *after* that. So foo::::bar becomes
$foo::{"::bar"} and main:::: becomes $main::{"::"}.

The code that assigns the name to the stash and the early exit are
both inside an if(we have a package separator) block, but the final ::
is not considered one, so a nameless hash is returned.

The easiest way to fix this is to revert just the changes to
lines that deal with the name (since the other deleted lines are
really dead).

diff --git a/gv.c b/gv.c
index 96301ff..b1bc60f 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -959,8 +959,9 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
     if (!tmpgv)
        return NULL;
     stash = GvHV(tmpgv);
+    if (!HvNAME_get(stash))
+       hv_name_set(stash, name, namelen, 0);
     assert(stash);
-    assert(HvNAME_get(stash));
     return stash;
 }
 

diff --git a/t/op/bless.t b/t/op/bless.t
index 14ef3d8..7ed3d43 100644 (file)
--- a/t/op/bless.t
+++ b/t/op/bless.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (108);
+plan (109);
 
 sub expected {
     my($object, $package, $type) = @_;
@@ -139,3 +139,6 @@ expected($c4, 'C4', "SCALAR");
     my $a = bless \(keys %h), 'zap';
     is(ref $a, 'zap');
 }
+
+bless [], "main::";
+ok(1, 'blessing into main:: does not crash'); # [perl #87388]