X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=88e343ab7e1d65a49416115e9f4df0094e5cb58e;hb=718842b0e14b2d067314bf35e22eac61894424e9;hp=09210956dad566ba1796c7ae20076fcc87fff38f;hpb=9ede5bc8744780ab88b609ed37e363bd7732ba2e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/gv.c b/gv.c index 0921095..88e343a 100644 --- a/gv.c +++ b/gv.c @@ -422,9 +422,17 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) 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); @@ -644,7 +652,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) char smallbuf[256]; char *tmpbuf; - if (len + 3 < sizeof smallbuf) + if (len + 3 < sizeof (smallbuf)) tmpbuf = smallbuf; else New(601, tmpbuf, len+3, char); @@ -1069,15 +1077,7 @@ Perl_gv_fullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain) 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 @@ -1092,10 +1092,7 @@ Perl_gv_efullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain) 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. */ @@ -1275,7 +1272,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) 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)) );