From: Nicholas Clark Date: Sun, 5 Mar 2006 19:07:12 +0000 (+0000) Subject: Perl_gv_name_set should not leak the old HEK. Allow the flag GV_ADD X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ae8cc45f19735266b98e68ac96abd0c5050c140f;p=p5sagit%2Fp5-mst-13.2.git Perl_gv_name_set should not leak the old HEK. Allow the flag GV_ADD to simplify GV initialisation. p4raw-id: //depot/perl@27382 --- diff --git a/gv.c b/gv.c index a458159..d02f741 100644 --- a/gv.c +++ b/gv.c @@ -215,7 +215,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) GvSTASH(gv) = stash; if (stash) Perl_sv_add_backref(aTHX_ (SV*)stash, (SV*)gv); - gv_name_set(gv, name, len, 0); + gv_name_set(gv, name, len, GV_ADD); if (multi || doproto) /* doproto means it _was_ mentioned */ GvMULTI_on(gv); if (doproto) { /* Replicate part of newSUB here. */ @@ -2114,6 +2114,10 @@ Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags) if (len > I32_MAX) Perl_croak(aTHX_ "panic: gv name too long (%"UVuf")", (UV) len); + if (!(flags & GV_ADD) && GvNAME_HEK(gv)) { + unshare_hek(GvNAME_HEK(gv)); + } + PERL_HASH(hash, name, len); GvNAME_HEK(gv) = name ? share_hek(name, len, hash) : 0; } diff --git a/gv.h b/gv.h index e3611c6..f48cb15 100644 --- a/gv.h +++ b/gv.h @@ -187,7 +187,9 @@ Return the SV from the GV. /* * symbol creation flags, for use in gv_fetchpv() and get_*v() */ -#define GV_ADD 0x01 /* add, if symbol not already there */ +#define GV_ADD 0x01 /* add, if symbol not already there + For gv_name_set, adding a HEK for the first + time, so don't try to free what's there. */ #define GV_ADDMULTI 0x02 /* add, pretending it has been added already */ #define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */ #define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval */ diff --git a/sv.c b/sv.c index 17d8cc2..a846af9 100644 --- a/sv.c +++ b/sv.c @@ -3216,7 +3216,7 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype) GvSTASH(dstr) = GvSTASH(sstr); if (GvSTASH(dstr)) Perl_sv_add_backref(aTHX_ (SV*)GvSTASH(dstr), dstr); - gv_name_set((GV *)dstr, name, len, 0); + gv_name_set((GV *)dstr, name, len, GV_ADD); SvFAKE_on(dstr); /* can coerce to non-glob */ }