HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ WARN_MISC, "Can't locate package %s for @%s::ISA",
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %s for @%s::ISA",
SvPVX(sv), HvNAME(stash));
continue;
}
DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
origname, HvNAME(stash), name) );
}
- else
+ else {
/* don't autovifify if ->NoSuchStash::method */
stash = gv_stashpvn(origname, nsplit - origname, FALSE);
+
+ /* however, explicit calls to Pkg::SUPER::method may
+ happen, and may require autovivification to work */
+ if (!stash && (nsplit - origname) >= 7 &&
+ strnEQ(nsplit - 7, "::SUPER", 7) &&
+ gv_stashpvn(origname, nsplit - origname - 7, FALSE))
+ stash = gv_stashpvn(origname, nsplit - origname, TRUE);
+ }
}
gv = gv_fetchmeth(stash, name, nend - name, 0);
/*
* Inheriting AUTOLOAD for non-methods works ... for now.
*/
- if (ckWARN(WARN_DEPRECATED) && !method &&
+ if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && !method &&
(GvCVGEN(gv) || GvSTASH(gv) != stash))
- Perl_warner(aTHX_ WARN_DEPRECATED,
+ Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
"Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
HvNAME(stash), (int)len, name);
char smallbuf[256];
char *tmpbuf;
- if (len + 3 < sizeof smallbuf)
+ if (len + 3 < sizeof (smallbuf))
tmpbuf = smallbuf;
else
New(601, tmpbuf, len+3, char);
: sv_type == SVt_PVAV ? "@"
: sv_type == SVt_PVHV ? "%"
: ""), name));
- stash = PL_nullstash;
}
- else
- return Nullgv;
+ return Nullgv;
}
if (!SvREFCNT(stash)) /* symbol table under destruction */
/* Adding a new symbol */
if (add & GV_ADDWARN && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "Had to create %s unexpectedly", nambeg);
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg);
gv_init(gv, stash, name, len, add & GV_ADDMULTI);
gv_init_sv(gv, sv_type);
goto magicalize;
case '#':
case '*':
- if (ckWARN(WARN_DEPRECATED) && len == 1 && sv_type == SVt_PV)
- Perl_warner(aTHX_ WARN_DEPRECATED, "Use of $%s is deprecated", name);
+ if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && len == 1 && sv_type == SVt_PV)
+ Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Use of $%s is deprecated", name);
/* FALL THROUGH */
case '[':
case '^':
void
Perl_gv_fullname3(pTHX_ SV *sv, GV *gv, const char *prefix)
{
- HV *hv = GvSTASH(gv);
- if (!hv) {
- (void)SvOK_off(sv);
- return;
- }
- sv_setpv(sv, prefix ? prefix : "");
- sv_catpv(sv,HvNAME(hv));
- sv_catpvn(sv,"::", 2);
- sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
+ gv_fullname4(sv, gv, prefix, TRUE);
}
void
void
Perl_gv_efullname3(pTHX_ SV *sv, GV *gv, const char *prefix)
{
- GV *egv = GvEGV(gv);
- if (!egv)
- egv = gv;
- gv_fullname3(sv, egv, prefix);
+ gv_efullname4(sv, gv, prefix, TRUE);
}
/* XXX compatibility with versions <= 5.003. */
#else
CopFILEGV(PL_curcop) = gv_fetchfile(file);
#endif
- Perl_warner(aTHX_ WARN_ONCE,
+ Perl_warner(aTHX_ packWARN(WARN_ONCE),
"Name \"%s::%s\" used only once: possible typo",
HvNAME(stash), GvNAME(gv));
}
return;
if (gp->gp_refcnt == 0) {
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL,
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Attempt to free unreferenced glob pointers");
return;
}
GvGP(gv) = 0;
}
-#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
-#define MICROPORT
-#endif
-
-#ifdef MICROPORT /* Microport 2.4 hack */
-AV *GvAVn(gv)
-register GV *gv;
-{
- if (GvGP(gv)->gp_av)
- return GvGP(gv)->gp_av;
- else
- return GvGP(gv_AVadd(gv))->gp_av;
-}
-
-HV *GvHVn(gv)
-register GV *gv;
-{
- if (GvGP(gv)->gp_hv)
- return GvGP(gv)->gp_hv;
- else
- return GvGP(gv_HVadd(gv))->gp_hv;
-}
-#endif /* Microport 2.4 hack */
-
int
Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
{
if (mg && amtp->was_ok_am == PL_amagic_generation
&& amtp->was_ok_sub == PL_sub_generation)
- return AMT_OVERLOADED(amtp);
+ return (bool)AMT_OVERLOADED(amtp);
sv_unmagic((SV*)stash, PERL_MAGIC_overload_table);
DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME(stash)) );
{
MAGIC *mg;
AMT *amtp;
+ CV *ret;
if (!stash)
return Nullcv;
if ( amtp->was_ok_am != PL_amagic_generation
|| amtp->was_ok_sub != PL_sub_generation )
goto do_update;
- if (AMT_AMAGIC(amtp))
- return amtp->table[id];
+ if (AMT_AMAGIC(amtp)) {
+ ret = amtp->table[id];
+ if (ret && isGV(ret)) { /* Autoloading stab */
+ /* Passing it through may have resulted in a warning
+ "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, (char*)PL_AMG_names[id]);
+
+ if (gv && GvCV(gv))
+ return GvCV(gv);
+ }
+ return ret;
+ }
+
return Nullcv;
}
break;
case '\017': /* $^O & $^OPEN */
if (len == 1
- || (len == 4 && strEQ(name, "\027PEN")))
+ || (len == 4 && strEQ(name, "\017PEN")))
{
goto yes;
}