X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/3b6733bfa57f98be8915f7c25b14180d042dd456..5bfb7d0e2e2f3251d6322e902aed9479d39e920a:/gv.c

diff --git a/gv.c b/gv.c
index 00fed57..9834b7a 100644
--- a/gv.c
+++ b/gv.c
@@ -215,8 +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);
-    GvNAME(gv) = savepvn(name, len);
-    GvNAMELEN(gv) = len;
+    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. */
@@ -576,7 +575,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     GV* vargv;
     SV* varsv;
     const char *packname = "";
-    STRLEN packname_len;
+    STRLEN packname_len = 0;
 
     if (len == S_autolen && strnEQ(name, S_autoload, S_autolen))
 	return NULL;
@@ -897,7 +896,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 			*gvp == (GV*)&PL_sv_undef ||
 			SvTYPE(*gvp) != SVt_PVGV)
 		    {
-			stash = 0;
+			stash = NULL;
 		    }
 		    else if ((sv_type == SVt_PV   && !GvIMPORTED_SV(*gvp)) ||
 			     (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) ||
@@ -909,7 +908,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 			    name);
 			if (GvCVu(*gvp))
 			    Perl_warn(aTHX_ "\t(Did you mean &%s instead?)\n", name);
-			stash = 0;
+			stash = NULL;
 		    }
 		}
 	    }
@@ -1071,6 +1070,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 		    goto ro_magicalize;
 		if (strEQ(name2, "TF8LOCALE"))
 		    goto ro_magicalize;
+		if (strEQ(name2, "TF8CACHE"))
+		    goto magicalize;
 		break;
 	    case '\027':	/* $^WARNING_BITS */
 		if (strEQ(name2, "ARNING_BITS"))
@@ -1155,6 +1156,13 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 	    sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
 	    goto magicalize;
 
+	case '\010':	/* $^H */
+	    {
+		HV *const hv = GvHVn(gv);
+		hv_magic(hv, NULL, PERL_MAGIC_hints);
+	    }
+	    goto magicalize;
+
 	case '+':
 	{
 	    AV* const av = GvAVn(gv);
@@ -1193,7 +1201,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 	case '\004':	/* $^D */
 	case '\005':	/* $^E */
 	case '\006':	/* $^F */
-	case '\010':	/* $^H */
 	case '\011':	/* $^I, NOT \t in EBCDIC */
 	case '\016':	/* $^N */
 	case '\017':	/* $^O */
@@ -1348,7 +1355,7 @@ Perl_newGVgen(pTHX_ const char *pack)
 {
     dVAR;
     return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++),
-		      TRUE, SVt_PVGV);
+		      GV_ADD, SVt_PVGV);
 }
 
 /* hopefully this is only called on local symbol table entries */
@@ -1358,7 +1365,7 @@ Perl_gp_ref(pTHX_ GP *gp)
 {
     dVAR;
     if (!gp)
-	return (GP*)NULL;
+	return NULL;
     gp->gp_refcnt++;
     if (gp->gp_cv) {
 	if (gp->gp_cvgen) {
@@ -1401,8 +1408,8 @@ Perl_gp_free(pTHX_ GV *gv)
         return;
     }
 
-    if (gp->gp_sv) SvREFCNT_dec(gp->gp_sv);
-    if (gp->gp_av) SvREFCNT_dec(gp->gp_av);
+    SvREFCNT_dec(gp->gp_sv);
+    SvREFCNT_dec(gp->gp_av);
     /* FIXME - another reference loop GV -> symtab -> GV ?
        Somehow gp->gp_hv can end up pointing at freed garbage.  */
     if (gp->gp_hv && SvTYPE(gp->gp_hv) == SVt_PVHV) {
@@ -1412,9 +1419,9 @@ Perl_gp_free(pTHX_ GV *gv)
 		      G_DISCARD);
 	SvREFCNT_dec(gp->gp_hv);
     }
-    if (gp->gp_io)   SvREFCNT_dec(gp->gp_io);
-    if (gp->gp_cv)   SvREFCNT_dec(gp->gp_cv);
-    if (gp->gp_form) SvREFCNT_dec(gp->gp_form);
+    SvREFCNT_dec(gp->gp_io);
+    SvREFCNT_dec(gp->gp_cv);
+    SvREFCNT_dec(gp->gp_form);
 
     Safefree(gp);
     GvGP(gv) = 0;
@@ -1623,7 +1630,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table))
       && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
 			? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
-			: (CV **) NULL))
+			: NULL))
       && ((cv = cvp[off=method+assignshift])
 	  || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
 						          * usual method */
@@ -1741,7 +1748,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 	       && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table))
 	       && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
 			  ? (amtp = (AMT*)mg->mg_ptr)->table
-			  : (CV **) NULL))
+			  : NULL))
 	       && (cv = cvp[off=method])) { /* Method for right
 					     * argument found */
       lr=1;
@@ -2104,6 +2111,25 @@ Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags)
     return FALSE;
 }
 
+void
+Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
+{
+    dVAR;
+    U32 hash;
+
+    PERL_UNUSED_ARG(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;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd