static const char S_autoload[] = "AUTOLOAD";
static const STRLEN S_autolen = sizeof(S_autoload)-1;
+
+#ifdef PERL_DONT_CREATE_GVSV
+GV *
+Perl_gv_SVadd(pTHX_ GV *gv)
+{
+ if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
+ Perl_croak(aTHX_ "Bad symbol for scalar");
+ if (!GvSV(gv))
+ GvSV(gv) = NEWSV(72,0);
+ return gv;
+}
+#endif
+
GV *
Perl_gv_AVadd(pTHX_ register GV *gv)
{
GV *
Perl_gv_IOadd(pTHX_ register GV *gv)
{
- if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
- Perl_croak(aTHX_ "Bad symbol for filehandle");
+ if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) {
+
+ /*
+ * if it walks like a dirhandle, then let's assume that
+ * this is a dirhandle.
+ */
+ const char *fh = PL_op->op_type == OP_READDIR ||
+ PL_op->op_type == OP_TELLDIR ||
+ PL_op->op_type == OP_SEEKDIR ||
+ PL_op->op_type == OP_REWINDDIR ||
+ PL_op->op_type == OP_CLOSEDIR ?
+ "dirhandle" : "filehandle";
+ Perl_croak(aTHX_ "Bad symbol for %s", fh);
+ }
+
if (!GvIOp(gv)) {
#ifdef GV_UNIQUE_CHECK
if (GvUNIQUE(gv)) {
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] = '<';
- strcpy(tmpbuf + 2, name);
+ memcpy(tmpbuf + 2, name, tmplen - 1);
gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
if (!isGV(gv)) {
gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
- sv_setpv(GvSV(gv), name);
+#ifdef PERL_DONT_CREATE_GVSV
+ GvSV(gv) = newSVpvn(name, tmplen - 2);
+#else
+ sv_setpvn(GvSV(gv), name, tmplen - 2);
+#endif
if (PERLDB_LINE)
hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, PERL_MAGIC_dbfile);
}
return gv;
}
+/*
+=for apidoc gv_const_sv
+
+If C<gv> is a typeglob whose subroutine entry is a constant sub eligible for
+inlining, or C<gv> is a placeholder reference that would be promoted to such
+a typeglob, then returns the value returned by the sub. Otherwise, returns
+NULL.
+
+=cut
+*/
+
+SV *
+Perl_gv_const_sv(pTHX_ GV *gv)
+{
+ if (SvTYPE(gv) == SVt_PVGV)
+ return cv_const_sv(GvCVu(gv));
+ return SvROK(gv) ? SvRV(gv) : NULL;
+}
+
void
Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
{
register GP *gp;
const bool doproto = SvTYPE(gv) > SVt_NULL;
const char * const proto = (doproto && SvPOK(gv)) ? SvPVX_const(gv) : NULL;
+ SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL;
+
+ assert (!(proto && has_constant));
+
+ if (has_constant) {
+ /* The constant has to be a simple scalar type. */
+ switch (SvTYPE(has_constant)) {
+ case SVt_PVAV:
+ case SVt_PVHV:
+ case SVt_PVCV:
+ case SVt_PVFM:
+ case SVt_PVIO:
+ Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob",
+ sv_reftype(has_constant, 0));
+ }
+ SvRV_set(gv, NULL);
+ SvROK_off(gv);
+ }
sv_upgrade((SV*)gv, SVt_PVGV);
if (SvLEN(gv)) {
SvLEN_set(gv, 0);
SvPOK_off(gv);
} else
- Safefree(SvPVX_const(gv));
+ 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) = NULL;
+#else
GvSV(gv) = NEWSV(72,0);
+#endif
GvLINE(gv) = CopLINE(PL_curcop);
/* XXX Ideally this cast would be replaced with a change to const char*
in the struct. */
GvCVGEN(gv) = 0;
GvEGV(gv) = gv;
sv_magic((SV*)gv, (SV*)gv, PERL_MAGIC_glob, Nullch, 0);
- GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
+ GvSTASH(gv) = stash;
+ if (stash)
+ Perl_sv_add_backref(aTHX_ (SV*)stash, (SV*)gv);
GvNAME(gv) = savepvn(name, len);
GvNAMELEN(gv) = len;
if (multi || doproto) /* doproto means it _was_ mentioned */
if (doproto) { /* Replicate part of newSUB here. */
SvIOK_off(gv);
ENTER;
- /* XXX unsafe for threads if eval_owner isn't held */
- start_subparse(0,0); /* Create CV in compcv. */
- GvCV(gv) = PL_compcv;
+ if (has_constant) {
+ /* newCONSTSUB takes ownership of the reference from us. */
+ GvCV(gv) = newCONSTSUB(stash, name, has_constant);
+ } else {
+ /* XXX unsafe for threads if eval_owner isn't held */
+ (void) start_subparse(0,0); /* Create empty CV in compcv. */
+ GvCV(gv) = PL_compcv;
+ }
LEAVE;
PL_sub_generation++;
case SVt_PVHV:
(void)GvHVn(gv);
break;
+#ifdef PERL_DONT_CREATE_GVSV
+ case SVt_NULL:
+ case SVt_PVCV:
+ case SVt_PVFM:
+ break;
+ default:
+ (void)GvSVn(gv);
+#endif
}
}
}
gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
- av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : Nullav;
+ av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : NULL;
/* create and re-create @.*::SUPER::ISA on demand */
if (!av || !SvMAGIC(av)) {
/* 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
Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
{
register const char *nend;
- const char *nsplit = 0;
+ const char *nsplit = NULL;
GV* gv;
HV* ostash = stash;
if (stash && SvTYPE(stash) < SVt_PVHV)
- stash = Nullhv;
+ stash = NULL;
for (nend = name; *nend; nend++) {
if (*nend == '\'')
nsplit = ++nend;
}
if (nsplit) {
- const char *origname = name;
+ const char * const origname = name;
name = nsplit + 1;
if (*nsplit == ':')
--nsplit;
gv = gv_autoload4(ostash, name, nend - name, TRUE);
}
else if (autoload) {
- CV* cv = GvCV(gv);
+ CV* const cv = GvCV(gv);
if (!CvROOT(cv) && !CvXSUB(cv)) {
GV* stubgv;
GV* autogv;
return Nullgv;
if (stash) {
if (SvTYPE(stash) < SVt_PVHV) {
- packname = SvPV((SV*)stash, packname_len);
- stash = Nullhv;
+ packname = SvPV_const((SV*)stash, packname_len);
+ stash = NULL;
}
else {
packname = HvNAME_get(stash);
/*
* 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);
vargv = *(GV**)hv_fetch(varstash, S_autoload, S_autolen, TRUE);
ENTER;
- if (!isGV(vargv))
+ if (!isGV(vargv)) {
gv_init(vargv, varstash, S_autoload, S_autolen, FALSE);
+#ifdef PERL_DONT_CREATE_GVSV
+ GvSV(vargv) = NEWSV(72,0);
+#endif
+ }
LEAVE;
- varsv = GvSV(vargv);
+ varsv = GvSVn(vargv);
sv_setpvn(varsv, packname, packname_len);
sv_catpvn(varsv, "::", 2);
sv_catpvn(varsv, name, len);
HV*
Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
{
- char smallbuf[256];
+ char smallbuf[128];
char *tmpbuf;
HV *stash;
GV *tmpgv;
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++] = ':';
tmpbuf[namelen] = '\0';
- tmpgv = gv_fetchpv(tmpbuf, create, SVt_PVHV);
+ tmpgv = gv_fetchpvn_flags(tmpbuf, namelen, create, SVt_PVHV);
if (tmpbuf != smallbuf)
Safefree(tmpbuf);
if (!tmpgv)
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;
}
Perl_gv_stashsv(pTHX_ SV *sv, I32 create)
{
STRLEN len;
- const char *ptr = SvPV(sv,len);
+ const char * const ptr = SvPV_const(sv,len);
return gv_stashpvn(ptr, len, create);
}
GV *
Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type) {
STRLEN len;
- const char *nambeg = SvPV(name, len);
+ const char * const nambeg = SvPV_const(name, len);
return gv_fetchpvn_flags(nambeg, len, flags | SvUTF8(name), sv_type);
}
I32 sv_type)
{
register const char *name = nambeg;
- register GV *gv = 0;
+ register GV *gv = NULL;
GV**gvp;
I32 len;
register const char *namend;
- HV *stash = 0;
- const I32 add = flags & ~SVf_UTF8;
- (void)full_len;
+ HV *stash = NULL;
+ const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
+ const I32 no_expand = flags & GV_NOEXPAND;
+ const I32 add = flags & ~SVf_UTF8 & ~GV_NOADD_NOINIT & ~GV_NOEXPAND;
+
+ PERL_UNUSED_ARG(full_len);
if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
name++;
len = namend - name;
if (len > 0) {
- char smallbuf[256];
+ char smallbuf[128];
char *tmpbuf;
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 == ':')
if (!stash) {
if (add) {
- register SV *err = Perl_mess(aTHX_
+ SV * const err = Perl_mess(aTHX_
"Global symbol \"%s%s\" requires explicit package name",
(sv_type == SVt_PV ? "$"
: sv_type == SVt_PVAV ? "@"
if (USE_UTF8_IN_NAMES)
SvUTF8_on(err);
qerror(err);
- stash = GvHV(gv_fetchpv("<none>::", GV_ADDMULTI, SVt_PVHV));
+ stash = GvHV(gv_fetchpvn_flags("<none>::", 8, GV_ADDMULTI, SVt_PVHV));
}
else
return Nullgv;
require_errno(gv);
}
return gv;
- } else if (add & GV_NOINIT) {
+ } else if (no_init) {
+ return gv;
+ } else if (no_expand && SvROK(gv)) {
return gv;
}
} else
#endif
{
- const char *name2 = name + 1;
+ const char * const name2 = name + 1;
switch (*name) {
case 'A':
if (strEQ(name2, "RGV")) {
break;
case 'I':
if (strEQ(name2, "SA")) {
- AV* av = GvAVn(gv);
+ AV* const av = GvAVn(gv);
GvMULTI_on(gv);
sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0);
/* NOTE: No support for tied ISA */
break;
case 'O':
if (strEQ(name2, "VERLOAD")) {
- HV* hv = GvHVn(gv);
+ HV* const hv = GvHVn(gv);
GvMULTI_on(gv);
hv_magic(hv, Nullgv, PERL_MAGIC_overload);
}
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 ** init;
- 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;
goto ro_magicalize;
case ':':
- sv_setpv(GvSV(gv),PL_chopset);
+ sv_setpv(GvSVn(gv),PL_chopset);
goto magicalize;
case '?':
#ifdef COMPLEX_STATUS
- (void)SvUPGRADE(GvSV(gv), SVt_PVLV);
+ SvUPGRADE(GvSVn(gv), SVt_PVLV);
#endif
goto magicalize;
now (rather than going to magicalize)
*/
- sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
+ sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
if (sv_type == SVt_PVHV)
require_errno(gv);
break;
case '-':
{
- AV* av = GvAVn(gv);
+ AV* const av = GvAVn(gv);
sv_magic((SV*)av, Nullsv, PERL_MAGIC_regdata, Nullch, 0);
SvREADONLY_on(av);
goto magicalize;
}
case '*':
- if (sv_type == SVt_PV && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
- Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "$* is no longer supported");
- break;
case '#':
if (sv_type == SVt_PV && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "Use of $# is deprecated");
- goto magicalize;
+ "$%c is no longer supported", *name);
+ break;
case '|':
- sv_setiv(GvSV(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
+ sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
goto magicalize;
case '+':
{
- AV* av = GvAVn(gv);
+ AV* const av = GvAVn(gv);
sv_magic((SV*)av, (SV*)av, PERL_MAGIC_regdata, Nullch, 0);
SvREADONLY_on(av);
/* FALL THROUGH */
case '8':
case '9':
ro_magicalize:
- SvREADONLY_on(GvSV(gv));
+ SvREADONLY_on(GvSVn(gv));
/* FALL THROUGH */
case '[':
case '^':
case '\024': /* $^T */
case '\027': /* $^W */
magicalize:
- sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
+ sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
break;
case '\014': /* $^L */
- sv_setpv(GvSV(gv),"\f");
- PL_formfeed = GvSV(gv);
+ sv_setpvn(GvSVn(gv),"\f",1);
+ PL_formfeed = GvSVn(gv);
break;
case ';':
- sv_setpv(GvSV(gv),"\034");
+ sv_setpvn(GvSVn(gv),"\034",1);
break;
case ']':
{
- SV *sv = GvSV(gv);
+ SV * const sv = GvSVn(gv);
if (!sv_derived_from(PL_patchlevel, "version"))
- (void *)upg_version(PL_patchlevel);
+ upg_version(PL_patchlevel);
GvSV(gv) = vnumify(PL_patchlevel);
SvREADONLY_on(GvSV(gv));
SvREFCNT_dec(sv);
break;
case '\026': /* $^V */
{
- SV * const sv = GvSV(gv);
+ SV * const sv = GvSVn(gv);
GvSV(gv) = new_version(PL_patchlevel);
SvREADONLY_on(GvSV(gv));
SvREFCNT_dec(sv);
}
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 */
+ /* Clear the stashcache because a new IO could overrule a package name */
hv_clear(PL_stashcache);
- iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
+ iogv = gv_fetchpvn_flags("FileHandle::", 12, 0, SVt_PVHV);
/* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
- iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
+ iogv = gv_fetchpvn_flags("IO::Handle::", 12, TRUE, SVt_PVHV);
SvSTASH_set(io, (HV*)SvREFCNT_inc(GvHV(iogv)));
return io;
}
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;
}
int
Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
{
- AMT *amtp = (AMT*)mg->mg_ptr;
- (void)sv;
+ AMT * const amtp = (AMT*)mg->mg_ptr;
+ PERL_UNUSED_ARG(sv);
if (amtp && AMT_AMAGIC(amtp)) {
int i;
for (i = 1; i < NofAMmeth; i++) {
- CV *cv = amtp->table[i];
+ CV * const cv = amtp->table[i];
if (cv != Nullcv) {
SvREFCNT_dec((SV *) cv);
amtp->table[i] = Nullcv;
bool
Perl_Gv_AMupdate(pTHX_ HV *stash)
{
- GV* gv;
- CV* cv;
- MAGIC* mg=mg_find((SV*)stash, PERL_MAGIC_overload_table);
- AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
+ MAGIC* const mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
+ AMT * const amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
AMT amt;
if (mg && amtp->was_ok_am == PL_amagic_generation
{
int filled = 0, have_ovl = 0;
int i, lim = 1;
- SV* sv = NULL;
/* Work with "fallback" key, which we assume to be first in PL_AMG_names */
/* Try to find via inheritance. */
- gv = gv_fetchmeth(stash, PL_AMG_names[0], 2, -1);
- if (gv)
- sv = GvSV(gv);
+ GV *gv = gv_fetchmeth(stash, PL_AMG_names[0], 2, -1);
+ SV * const sv = gv ? GvSV(gv) : NULL;
+ CV* cv;
if (!gv)
lim = DESTROY_amg; /* Skip overloading entries. */
+#ifdef PERL_DONT_CREATE_GVSV
+ else if (!sv) {
+ /* Equivalent to !SvTRUE and !SvOK */
+ }
+#endif
else if (SvTRUE(sv))
amt.fallback=AMGfallYES;
else if (SvOK(sv))
knowing *which* methods were declared as overloaded. */
/* GvSV contains the name of the method. */
GV *ngv = Nullgv;
+ SV *gvsv = GvSV(gv);
DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
"\" for overloaded \"%s\" in package \"%.256s\"\n",
GvSV(gv), cp, hvname) );
- if (!SvPOK(GvSV(gv))
- || !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(GvSV(gv)),
+ if (!gvsv || !SvPOK(gvsv)
+ || !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(gvsv),
FALSE)))
{
/* Can be an import stub (created by "can"). */
- SV *gvsv = GvSV(gv);
- const char *name = SvPOK(gvsv) ? SvPVX_const(gvsv) : "???";
+ const char * const name = (gvsv && SvPOK(gvsv)) ? SvPVX_const(gvsv) : "???";
Perl_croak(aTHX_ "%s method \"%.256s\" overloading \"%s\" "\
"in package \"%.256s\"",
(GvCVGEN(gv) ? "Stub found while resolving"
}
cv = GvCV(gv = ngv);
}
- DEBUG_o( Perl_deb(aTHX_ "Overloading \"%s\" in package \"%.256s\" "\
- "via \"%.256s::%.256s\"\n",
+ DEBUG_o( Perl_deb(aTHX_ "Overloading \"%s\" in package \"%.256s\" via \"%.256s::%.256s\"\n",
cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))),
GvNAME(CvGV(cv))) );
filled = 1;
"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);
CV *cv=NULL;
CV **cvp=NULL, **ocvp=NULL;
AMT *amtp=NULL, *oamtp=NULL;
- int off=0, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
- int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0;
+ int off = 0, off1, lr = 0, notfound = 0;
+ int postpr = 0, force_cpy = 0;
+ int assign = AMGf_assign & flags;
+ const int assignshift = assign ? 1 : 0;
#ifdef DEBUGGING
int fl=0;
#endif
* 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(name, len);
+ const char * const temp = SvPV_const(name, len);
return is_gv_magical(temp, len, flags);
}
bool
Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags)
{
- (void)flags;
+ PERL_UNUSED_ARG(flags);
+
if (len > 1) {
- const char *name1 = name + 1;
+ const char * const name1 = name + 1;
switch (*name) {
case 'I':
if (len == 3 && name1[1] == 'S' && name[2] == 'A')
https://perl5.git.perl.org / perl5.git / blobdiff