Teach ss_dup about SAVEt_RE_STATE. (As correctly as it ever was before)

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index 00fed57..9834b7a 100644 (file)
--- 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