diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-11-28 18:31:55 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-11-28 20:41:03 -0800 |
commit | f9509170c89f15affdd1afdeff1c5fcbc00c51a3 (patch) | |
tree | 3d1bc6764f2868b291e653c7d318bb674510598e /gv.c | |
parent | 3c7be43ff115659a3b88a71696bf4228733c9bca (diff) | |
download | perl-f9509170c89f15affdd1afdeff1c5fcbc00c51a3.tar.gz |
panic after cow-to-stash assignment
This type of thing isn’t officially supported, but perl shouldn’t be
freeing unallocated memory (the 9th octet of a freed HEK) as a result:
$::{whatever} = __PACKAGE__;
*{"whatever"};
A string stored in the symbol table like that is actually a subroutine
stub. ‘sub foo($)’ is stored as '$' in the "foo" slot to save space.
gv_init_pvn (formerly known as gv_init) checks SvPOK first thing,
assuming, if it is set, that it can reuse SvPVX as the CV’s prototype,
without reallocating or copying it. That works most of the time.
For COW strings (such as those returned by __PACKAGE__), SvPVX points
to the hek_key field (the 9th octet) of a shared HEK. When the CV is
freed, it ends up trying to do Safefree(that_hek + 8) effectively,
which is bad.
Diffstat (limited to 'gv.c')
-rw-r--r-- | gv.c | 4 |
1 files changed, 3 insertions, 1 deletions
@@ -316,7 +316,9 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag dVAR; const U32 old_type = SvTYPE(gv); const bool doproto = old_type > SVt_NULL; - char * const proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL; + char * const proto = (doproto && SvPOK(gv)) + ? (SvIsCOW(gv) && (sv_force_normal((SV *)gv), 0), SvPVX(gv)) + : NULL; const STRLEN protolen = proto ? SvCUR(gv) : 0; const U32 proto_utf8 = proto ? SvUTF8(gv) : 0; SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL; |