Skip to content

Commit

Permalink
[perl #87388] bless[], "main::" crashes
Browse files Browse the repository at this point in the history
As mention in the ticket, this was caused by b4dd662, which removed
‘dead’ code from gv_stashpvn:

commit b4dd662
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).
  • Loading branch information
Father Chrysostomos committed Apr 7, 2011
1 parent 837c879 commit 1a063a8
Show file tree
Hide file tree
Showing 2 changed files with 6 additions and 2 deletions.
3 changes: 2 additions & 1 deletion gv.c
Expand Up @@ -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;
}

Expand Down
5 changes: 4 additions & 1 deletion t/op/bless.t
Expand Up @@ -6,7 +6,7 @@ BEGIN {
require './test.pl';
}

plan (108);
plan (109);

sub expected {
my($object, $package, $type) = @_;
Expand Down Expand Up @@ -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]

0 comments on commit 1a063a8

Please sign in to comment.