if (tmplen < sizeof smallbuf)
tmpbuf = smallbuf;
else
- New(603, tmpbuf, tmplen + 1, char);
+ Newx(tmpbuf, tmplen + 1, char);
/* This is where the debugger's %{"::_<$filename"} hash is created */
tmpbuf[0] = '_';
tmpbuf[1] = '<';
} else
Safefree(SvPVX_mutable(gv));
}
- Newz(602, gp, 1, GP);
+ Newxz(gp, 1, GP);
GvGP(gv) = gp_ref(gp);
#ifdef PERL_DONT_CREATE_GVSV
GvSV(gv) = 0;
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;
/* 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",
/* 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)))
{
}
/*
-=for apidoc gv_fetchmethod
-
-See L<gv_fetchmethod_autoload>.
-
-=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
/*
* Inheriting AUTOLOAD for non-methods works ... for now.
*/
- if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && !method &&
- (GvCVGEN(gv) || GvSTASH(gv) != stash))
+ if (!method && (GvCVGEN(gv) || GvSTASH(gv) != stash)
+ && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)
+ )
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
"Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
packname, (int)len, name);
#endif
}
LEAVE;
- varsv = GvSV(vargv);
+ varsv = GvSVn(vargv);
sv_setpvn(varsv, packname, packname_len);
sv_catpvn(varsv, "::", 2);
sv_catpvn(varsv, name, len);
if (namelen + 3 < sizeof smallbuf)
tmpbuf = smallbuf;
else
- New(606, tmpbuf, namelen + 3, char);
+ Newx(tmpbuf, namelen + 3, char);
Copy(name,tmpbuf,namelen,char);
tmpbuf[namelen++] = ':';
tmpbuf[namelen++] = ':';
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;
}
register const char *namend;
HV *stash = 0;
const I32 add = flags & ~SVf_UTF8;
- (void)full_len;
+
+ PERL_UNUSED_ARG(full_len);
if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
name++;
if (len + 3 < sizeof (smallbuf))
tmpbuf = smallbuf;
else
- New(601, tmpbuf, len+3, char);
+ Newx(tmpbuf, len+3, char);
Copy(name, tmpbuf, len, char);
tmpbuf[len++] = ':';
tmpbuf[len++] = ':';
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 == ':')
HV *hv;
I32 i;
if (!PL_psig_ptr) {
- Newz(73, PL_psig_ptr, SIG_SIZE, SV*);
- Newz(73, PL_psig_name, SIG_SIZE, SV*);
- Newz(73, PL_psig_pend, SIG_SIZE, int);
+ Newxz(PL_psig_ptr, SIG_SIZE, SV*);
+ Newxz(PL_psig_name, SIG_SIZE, SV*);
+ Newxz(PL_psig_pend, SIG_SIZE, int);
}
GvMULTI_on(gv);
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;
}
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 *egv = GvEGV(gv);
- if (!egv)
- egv = gv;
- gv_fullname4(sv, egv, 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 ? "*" : "");
+ const GV * const egv = GvEGV(gv);
+ gv_fullname4(sv, egv ? egv : gv, prefix, keepmain);
}
IO *
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);
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;
}
"Inherited AUTOLOAD for a non-method deprecated", since
our caller is going through a function call, not a method call.
So return the CV for AUTOLOAD, setting $AUTOLOAD. */
- GV *gv = gv_fetchmethod(stash, PL_AMG_names[id]);
+ GV * const gv = gv_fetchmethod(stash, PL_AMG_names[id]);
if (gv && GvCV(gv))
return GvCV(gv);
* SV* ref causes confusion with the interpreter variable of
* the same name
*/
- SV* tmpRef=SvRV(left);
+ SV* const tmpRef=SvRV(left);
if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) {
/*
* Just to be extra cautious. Maybe in some
* additional cases sv_setsv is safe, too.
*/
- SV* newref = newSVsv(tmpRef);
+ SV* const newref = newSVsv(tmpRef);
SvOBJECT_on(newref);
SvSTASH_set(newref, (HV*)SvREFCNT_inc(SvSTASH(tmpRef)));
return newref;
case abs_amg:
if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg])
&& ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) {
- SV* nullsv=sv_2mortal(newSViv(0));
+ SV* const nullsv=sv_2mortal(newSViv(0));
if (off1==lt_amg) {
- SV* lessp = amagic_call(left,nullsv,
+ SV* const lessp = amagic_call(left,nullsv,
lt_amg,AMGf_noright);
logic = SvTRUE(lessp);
} else {
- SV* lessp = amagic_call(left,nullsv,
+ SV* const lessp = amagic_call(left,nullsv,
ncmp_amg,AMGf_noright);
logic = (SvNV(lessp) < 0);
}
Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags)
{
STRLEN len;
- const char *temp = SvPV_const(name, len);
+ const char * const temp = SvPV_const(name, len);
return is_gv_magical(temp, len, flags);
}
https://perl5.git.perl.org / perl5.git / blobdiff