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 a458159d76b059f8ae13bb2a7cde80d2aef8bb5e..d02f741e44c1442b08f56bfe988663ed6dde65f7 100644 (file)
--- 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 e3611c6e56d9bb653dd20196a8d79eaf81102c9f..f48cb15475102d4dd84ca74ba898165ea7e5febe 100644 (file)
--- 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 17d8cc20692b6551db0f8e015ec29d829ca7eed6..a846af98aaff0ebb37aba51589ae6c560ba8df2e 100644 (file)
--- 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 */
     }