From 1a063a891daa888a733d9623fd6d707de87c6bd9 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Wed, 6 Apr 2011 22:44:28 -0700
Subject: [PATCH] [perl #87388] bless[], "main::" crashes
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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).
---
 gv.c         | 3 ++-
 t/op/bless.t | 5 ++++-
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/gv.c b/gv.c
index 96301ff15107..b1bc60f4e652 100644
--- 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 14ef3d8c1194..7ed3d433cd7f 100644
--- 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]