char *name;
{
char tmpbuf[1200];
+ STRLEN tmplen;
GV *gv;
- sprintf(tmpbuf,"::_<%s", name);
- gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV);
+ sprintf(tmpbuf, "_<%s", name);
+ tmplen = strlen(tmpbuf);
+ gv = *(GV**)hv_fetch(defstash, tmpbuf, tmplen, TRUE);
+ if (!isGV(gv))
+ gv_init(gv, defstash, tmpbuf, tmplen, FALSE);
sv_setpv(GvSV(gv), name);
- if (*name == '/' && (instr(name,"/lib/") || instr(name,".pm")))
+ if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm")))
GvMULTI_on(gv);
if (perldb)
hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
sv_upgrade((SV*)gv, SVt_PVGV);
if (SvLEN(gv))
Safefree(SvPVX(gv));
- Newz(602,gp, 1, GP);
+ Newz(602, gp, 1, GP);
GvGP(gv) = gp_ref(gp);
- GvREFCNT(gv) = 1;
GvSV(gv) = NEWSV(72,0);
GvLINE(gv) = curcop->cop_line;
GvFILEGV(gv) = curcop->cop_filegv;
if (!stash)
return 0;
- if (level > 100)
+ if ((level > 100) || (level < -100))
croak("Recursive inheritance detected");
- gvp = (GV**)hv_fetch(stash, name, len, TRUE);
-
DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
- topgv = *gvp;
- if (SvTYPE(topgv) != SVt_PVGV)
- gv_init(topgv, stash, name, len, TRUE);
-
- if (cv = GvCV(topgv)) {
- if (CvXSUB(cv) || CvROOT(cv) || CvGV(cv)) { /* Not deleted, possibly autoloaded. */
- if (GvCVGEN(topgv) >= sub_generation)
- return topgv; /* valid cached inheritance */
- if (!GvCVGEN(topgv)) { /* not an inheritance cache */
+
+ gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
+ if (!gvp)
+ topgv = Nullgv;
+ else {
+ topgv = *gvp;
+ if (SvTYPE(topgv) != SVt_PVGV)
+ gv_init(topgv, stash, name, len, TRUE);
+ if (cv = GvCV(topgv)) {
+ /* If genuine method or valid cache entry, use it */
+ if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation)
return topgv;
- }
+ /* Stale cached entry: junk it */
+ SvREFCNT_dec(cv);
+ GvCV(topgv) = cv = Nullcv;
+ GvCVGEN(topgv) = 0;
}
- /* stale cached entry, just junk it */
- SvREFCNT_dec(cv);
- GvCV(topgv) = cv = 0;
- GvCVGEN(topgv) = 0;
}
- /* Now cv = 0, and there is no cv in topgv. */
gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
SvPVX(sv), HvNAME(stash));
continue;
}
- gv = gv_fetchmeth(basestash, name, len, level + 1);
- if (gv) {
- GvCV(topgv) = GvCV(gv); /* cache the CV */
- GvCVGEN(topgv) = sub_generation; /* valid for now */
- SvREFCNT_inc(GvCV(gv));
- return gv;
- }
+ gv = gv_fetchmeth(basestash, name, len,
+ (level >= 0) ? level + 1 : level - 1);
+ if (gv)
+ goto gotcha;
}
}
- if (!level) {
+ if (level == 0 || level == -1) {
if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) {
- if (gv = gv_fetchmeth(lastchance, name, len, level + 1)) {
- GvCV(topgv) = GvCV(gv); /* cache the CV */
- GvCVGEN(topgv) = sub_generation; /* valid for now */
- SvREFCNT_inc(GvCV(gv));
+ if (gv = gv_fetchmeth(lastchance, name, len,
+ (level >= 0) ? level + 1 : level - 1)) {
+ gotcha:
+ /* Use topgv for cache only if it has no synonyms */
+ if (topgv && GvREFCNT(topgv) == 1) {
+ if (cv = GvCV(topgv))
+ SvREFCNT_dec(cv);
+ GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
+ GvCVGEN(topgv) = sub_generation;
+ }
return gv;
}
}
}
if (!gv) {
- CV* cv;
-
if (strEQ(name,"import"))
gv = (GV*)&sv_yes;
- else if (strNE(name, "AUTOLOAD")) {
- gv = gv_fetchmeth(stash, "AUTOLOAD", 8, 0);
- if (gv && (cv = GvCV(gv))) { /* One more chance... */
- SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
- sv_catpvn(tmpstr,"::", 2);
- sv_catpvn(tmpstr, name, nend - name);
- sv_setsv(GvSV(CvGV(cv)), tmpstr);
- SvTAINTED_off(GvSV(CvGV(cv)));
- }
- }
+ else
+ gv = gv_autoload(stash, name, nend - name);
}
+
+ return gv;
+}
+
+GV*
+gv_autoload(stash, name, len)
+HV* stash;
+char* name;
+STRLEN len;
+{
+ static char autoload[] = "AUTOLOAD";
+ static STRLEN autolen = 8;
+ GV* gv;
+ CV* cv;
+ HV* varstash;
+ GV* vargv;
+ SV* varsv;
+
+ if (len == autolen && strnEQ(name, autoload, autolen))
+ return Nullgv;
+ if (!(gv = gv_fetchmeth(stash, autoload, autolen, 0)))
+ return Nullgv;
+ cv = GvCV(gv);
+
+ /*
+ * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
+ * The subroutine's original name may not be "AUTOLOAD", so we don't
+ * use that, but for lack of anything better we will use the sub's
+ * original package to look up $AUTOLOAD.
+ */
+ varstash = GvSTASH(CvGV(cv));
+ vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
+ if (!isGV(vargv))
+ gv_init(vargv, varstash, autoload, autolen, FALSE);
+ varsv = GvSV(vargv);
+ sv_setpv(varsv, HvNAME(stash));
+ sv_catpvn(varsv, "::", 2);
+ sv_catpvn(varsv, name, len);
+ SvTAINTED_off(varsv);
return gv;
}
#ifdef VMS
warn("Weird package name \"%s\" truncated", name);
#else
- warn("Weird package name \"%.*s...\" truncated", namelen, name);
+ warn("Weird package name \"%.*s...\" truncated", (int)namelen, name);
#endif
}
Copy(name,tmpbuf,namelen,char);
sv_type == SVt_PVAV ? '@' :
sv_type == SVt_PVHV ? '%' : '$',
name);
- if (GvCV(*gvp))
+ if (GvCVu(*gvp))
warn("(Did you mean &%s instead?)\n", name);
stash = 0;
}
sv_setpv(GvSV(gv),chopset);
goto magicalize;
+ case '?':
+ if (len > 1)
+ break;
+#ifdef COMPLEX_STATUS
+ sv_upgrade(GvSV(gv), SVt_PVLV);
+#endif
+ goto magicalize;
+
case '#':
case '*':
if (dowarn && len == 1 && sv_type == SVt_PV)
/* FALL THROUGH */
case '[':
case '!':
- case '?':
case '^':
case '~':
case '=':
break;
case ']':
if (len == 1) {
- SV *sv;
- sv = GvSV(gv);
+ SV *sv = GvSV(gv);
sv_upgrade(sv, SVt_PVNV);
sv_setpv(sv, patchlevel);
+ (void)sv_2nv(sv);
+ SvREADONLY_on(sv);
}
break;
}
GP* gp;
{
gp->gp_refcnt++;
+ if (gp->gp_cv) {
+ if (gp->gp_cvgen) {
+ /* multi-named GPs cannot be used for method cache */
+ SvREFCNT_dec(gp->gp_cv);
+ gp->gp_cv = Nullcv;
+ gp->gp_cvgen = 0;
+ }
+ else {
+ /* Adding a new name to a subroutine invalidates method cache */
+ sub_generation++;
+ }
+ }
return gp;
-
}
void
warn("Attempt to free unreferenced glob pointers");
return;
}
+ if (gp->gp_cv) {
+ /* Deleting the name of a subroutine invalidates method cache */
+ sub_generation++;
+ }
if (--gp->gp_refcnt > 0) {
if (gp->gp_egv == gv)
gp->gp_egv = 0;
AMT *amtp=mg ? (AMT*)mg->mg_ptr: NULL;
AMT amt;
- if (mg && (amtp=((AMT*)(mg->mg_ptr)))->was_ok_am == amagic_generation &&
- amtp->was_ok_sub == sub_generation)
+ if (mg && amtp->was_ok_am == amagic_generation
+ && amtp->was_ok_sub == sub_generation)
return AMT_AMAGIC(amtp);
if (amtp && AMT_AMAGIC(amtp)) { /* Have table. */
int i;
croak("Not a subroutine reference in overload table");
return FALSE;
case SVt_PVCV:
- cv = (CV*)sv;
- break;
+ cv = (CV*)sv;
+ break;
case SVt_PVGV:
- if (!(cv = GvCV((GV*)sv)))
- cv = sv_2cv(sv, &stash, &gv, TRUE);
- break;
+ if (!(cv = GvCVu((GV*)sv)))
+ cv = sv_2cv(sv, &stash, &gv, TRUE);
+ break;
}
if (cv) filled=1;
else {
if ( cp = (char *)AMG_names[0] ) {
/* Try to find via inheritance. */
- gv = gv_fetchmeth(stash, "()", 2, 0); /* A cooky: "()". */
+ gv = gv_fetchmeth(stash, "()", 2, -1); /* A cookie: "()". */
if (gv) sv = GvSV(gv);
- if (!sv) /* Empty */;
+ if (!gv) goto no_table;
else if (SvTRUE(sv)) amt.fallback=AMGfallYES;
else if (SvOK(sv)) amt.fallback=AMGfallNEVER;
}
cv = 0;
cp = (char *)AMG_names[i];
- *buf = '('; /* A cooky: "(". */
+ *buf = '('; /* A cookie: "(". */
strcpy(buf + 1, cp);
- gv = gv_fetchmeth(stash, buf, strlen(buf), 0); /* fills the stash! */
- if(gv && (cv = GvCV(gv))) filled = 1;
+ DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n",
+ cp, HvNAME(stash)) );
+ gv = gv_fetchmeth(stash, buf, strlen(buf), -1); /* no filling stash! */
+ if(gv && (cv = GvCV(gv))) {
+ char *name = buf;
+ if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
+ && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) {
+ /* GvSV contains the name of the method. */
+ GV *ngv;
+
+ DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
+ SvPV(GvSV(gv), na), cp, HvNAME(stash)) );
+ if (SvPOK(GvSV(gv))
+ && (ngv = gv_fetchmethod(stash, SvPVX(GvSV(gv))))) {
+ name = SvPVX(GvSV(gv));
+ cv = GvCV(gv = ngv);
+ } else {
+ /* Can be an import stub (created by `can'). */
+ if (GvCVGEN(gv)) {
+ croak("Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'",
+ (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ),
+ cp, HvNAME(stash));
+ } else
+ croak("Cannot resolve method `%.256s' overloading `%s' in package `%.256s'",
+ (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ),
+ cp, HvNAME(stash));
+ }
+ /* If the sub is only a stub then we may have a gv to AUTOLOAD */
+ gv = (GV*)*hv_fetch(GvSTASH(gv), name, strlen(name), TRUE);
+ cv = GvCV(gv);
+ }
+ DEBUG_o( deb("Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
+ cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),
+ GvNAME(CvGV(cv))) );
+ filled = 1;
+ }
#endif
amt.table[i]=(CV*)SvREFCNT_inc(cv);
}
}
}
/* Here we have no table: */
+ no_table:
AMT_AMAGIC_off(&amt);
sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMTS));
return FALSE;
} else if (cvp && (cv=cvp[nomethod_amg])) {
notfound = 1; lr = 1;
} else {
- if (off==-1) off=method;
- sprintf(buf, "Operation `%s': no method found,\n\tleft argument %s%.256s,\n\tright argument %s%.256s",
+ if (off==-1) off=method;
+ sprintf(buf,
+ "Operation `%s': no method found,%sargument %s%.256s%s%.256s",
AMG_names[method + assignshift],
+ (flags & AMGf_unary ? " " : "\n\tleft "),
SvAMAGIC(left)?
"in overloaded package ":
"has no overloaded magic",
HvNAME(SvSTASH(SvRV(left))):
"",
SvAMAGIC(right)?
- "in overloaded package ":
- "has no overloaded magic",
+ ",\n\tright argument in overloaded package ":
+ (flags & AMGf_unary
+ ? ""
+ : ",\n\tright argument has no overloaded magic"),
SvAMAGIC(right)?
HvNAME(SvSTASH(SvRV(right))):
"");
}
}
if (!notfound) {
- DEBUG_o( deb("Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.256s%s\n",
+ DEBUG_o( deb(
+ "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.256s%s\n",
AMG_names[off],
method+assignshift==off? "" :
" (initially `",
res=POPs;
PUTBACK;
- if (notfound) {
- /* sv_2mortal(res); */
- return NULL;
- }
-
if (postpr) {
int ans;
switch (method) {
case dec_amg:
SvSetSV(left,res); return left;
case not_amg:
-ans=!SvOK(res); break;
+ ans=!SvOK(res); break;
}
return ans? &sv_yes: &sv_no;
} else if (method==copy_amg) {