X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ae8cc45f19735266b98e68ac96abd0c5050c140f..5bfb7d0e2e2f3251d6322e902aed9479d39e920a:/gv.c diff --git a/gv.c b/gv.c index d02f741..9834b7a 100644 --- a/gv.c +++ b/gv.c @@ -575,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; @@ -896,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)) || @@ -908,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; } } } @@ -1070,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")) @@ -1154,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); @@ -1192,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 */ @@ -1347,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 */ @@ -1357,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) { @@ -1400,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) { @@ -1411,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; @@ -1622,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 */ @@ -1740,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;