X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/46c461b51dd657dd9227e8d230ce0a737a33cb3e..ce8abf5f5d2e5b19646ab17c24a3ea87c70428c8:/gv.c diff --git a/gv.c b/gv.c index 2726840..0ad4c0f 100644 --- a/gv.c +++ b/gv.c @@ -164,7 +164,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) SvIOK_off(gv); ENTER; /* XXX unsafe for threads if eval_owner isn't held */ - start_subparse(0,0); /* Create CV in compcv. */ + (void) start_subparse(0,0); /* Create empty CV in compcv. */ GvCV(gv) = PL_compcv; LEAVE; @@ -302,8 +302,8 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) /* NOTE: No support for tied ISA */ I32 items = AvFILLp(av) + 1; while (items--) { - SV* sv = *svp++; - HV* basestash = gv_stashsv(sv, FALSE); + SV* const sv = *svp++; + HV* const basestash = gv_stashsv(sv, FALSE); if (!basestash) { if (ckWARN(WARN_MISC)) Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA", @@ -320,9 +320,9 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) /* if at top level, try UNIVERSAL */ if (level == 0 || level == -1) { - HV* lastchance; + HV* const lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE); - if ((lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE))) { + if (lastchance) { if ((gv = gv_fetchmeth(lastchance, name, len, (level >= 0) ? level + 1 : level - 1))) { @@ -397,20 +397,6 @@ Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 le } /* -=for apidoc gv_fetchmethod - -See L. - -=cut -*/ - -GV * -Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name) -{ - return gv_fetchmethod_autoload(stash, name, TRUE); -} - -/* =for apidoc gv_fetchmethod_autoload Returns the glob which contains the subroutine to call to invoke the method @@ -669,7 +655,7 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create) GvHV(tmpgv) = newHV(); stash = GvHV(tmpgv); if (!HvNAME_get(stash)) - Perl_hv_name_set(aTHX_ stash, name, namelen, 0); + hv_name_set(stash, name, namelen, 0); return stash; } @@ -759,7 +745,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, stash = GvHV(gv) = newHV(); if (!HvNAME_get(stash)) - Perl_hv_name_set(aTHX_ stash, nambeg, namend - nambeg, 0); + hv_name_set(stash, nambeg, namend - nambeg, 0); } if (*namend == ':') @@ -958,7 +944,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, hv = GvHVn(gv); hv_magic(hv, Nullgv, PERL_MAGIC_sig); for (i = 1; i < SIG_SIZE; i++) { - SV ** const init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); + SV * const * const init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); if (init) sv_setsv(*init, &PL_sv_undef); PL_psig_ptr[i] = 0; @@ -1183,38 +1169,12 @@ Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain) } void -Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix) -{ - gv_fullname4(sv, gv, prefix, TRUE); -} - -void Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain) { const GV * const egv = GvEGV(gv); gv_fullname4(sv, egv ? egv : gv, prefix, keepmain); } -void -Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix) -{ - gv_efullname4(sv, gv, prefix, TRUE); -} - -/* compatibility with versions <= 5.003. */ -void -Perl_gv_fullname(pTHX_ SV *sv, const GV *gv) -{ - gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : ""); -} - -/* compatibility with versions <= 5.003. */ -void -Perl_gv_efullname(pTHX_ SV *sv, const GV *gv) -{ - gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : ""); -} - IO * Perl_newIO(pTHX) { @@ -1222,7 +1182,10 @@ Perl_newIO(pTHX) IO * const io = (IO*)NEWSV(0,0); sv_upgrade((SV *)io,SVt_PVIO); - SvREFCNT(io) = 1; + /* This used to read SvREFCNT(io) = 1; + It's not clear why the reference count needed an explicit reset. NWC + */ + assert (SvREFCNT(io) == 1); SvOBJECT_on(io); /* Clear the stashcache because a new IO could overrule a package name */ hv_clear(PL_stashcache); @@ -1260,14 +1223,14 @@ Perl_gv_check(pTHX_ HV *stash) file = GvFILE(gv); /* performance hack: if filename is absolute and it's a standard * module, don't bother warning */ - if (file - && PERL_FILE_IS_ABSOLUTE(file) #ifdef MACOS_TRADITIONAL - && (instr(file, ":lib:") +# define LIB_COMPONENT ":lib:" #else - && (instr(file, "/lib/") +# define LIB_COMPONENT "/lib/" #endif - || instr(file, ".pm"))) + if (file + && PERL_FILE_IS_ABSOLUTE(file) + && (instr(file, LIB_COMPONENT) || instr(file, ".pm"))) { continue; }