X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=317cbb0a3376c3089727ecb400e930ee0b32ed53;hb=5f758ba4b4162dea84a83b71f0e14f4eede76726;hp=5ae3cd34361a3bd6d6f644e3fc3e07a84e3466ba;hpb=864dbfa3ca8032ef66f7aa86961933b19b962357;p=p5sagit%2Fp5-mst-13.2.git diff --git a/gv.c b/gv.c index 5ae3cd3..317cbb0 100644 --- a/gv.c +++ b/gv.c @@ -1,6 +1,6 @@ /* gv.c * - * Copyright (c) 1991-1999, Larry Wall + * Copyright (c) 1991-2000, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -24,7 +24,7 @@ GV * Perl_gv_AVadd(pTHX_ register GV *gv) { if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) - croak("Bad symbol for array"); + Perl_croak(aTHX_ "Bad symbol for array"); if (!GvAV(gv)) GvAV(gv) = newAV(); return gv; @@ -34,7 +34,7 @@ GV * Perl_gv_HVadd(pTHX_ register GV *gv) { if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) - croak("Bad symbol for hash"); + Perl_croak(aTHX_ "Bad symbol for hash"); if (!GvHV(gv)) GvHV(gv) = newHV(); return gv; @@ -44,7 +44,7 @@ GV * Perl_gv_IOadd(pTHX_ register GV *gv) { if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) - croak("Bad symbol for filehandle"); + Perl_croak(aTHX_ "Bad symbol for filehandle"); if (!GvIOp(gv)) GvIOp(gv) = newIO(); return gv; @@ -59,6 +59,9 @@ Perl_gv_fetchfile(pTHX_ const char *name) STRLEN tmplen; GV *gv; + if (!PL_defstash) + return Nullgv; + tmplen = strlen(name) + 2; if (tmplen < sizeof smallbuf) tmpbuf = smallbuf; @@ -68,15 +71,14 @@ Perl_gv_fetchfile(pTHX_ const char *name) tmpbuf[1] = '<'; strcpy(tmpbuf + 2, name); gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE); - if (!isGV(gv)) + if (!isGV(gv)) { gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE); + sv_setpv(GvSV(gv), name); + if (PERLDB_LINE) + hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); + } if (tmpbuf != smallbuf) Safefree(tmpbuf); - sv_setpv(GvSV(gv), name); - if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm"))) - GvMULTI_on(gv); - if (PERLDB_LINE) - hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); return gv; } @@ -100,8 +102,8 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) Newz(602, gp, 1, GP); GvGP(gv) = gp_ref(gp); GvSV(gv) = NEWSV(72,0); - GvLINE(gv) = PL_curcop->cop_line; - GvFILEGV(gv) = PL_curcop->cop_filegv; + GvLINE(gv) = CopLINE(PL_curcop); + GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : ""; GvCVGEN(gv) = 0; GvEGV(gv) = gv; sv_magic((SV*)gv, (SV*)gv, '*', name, len); @@ -120,7 +122,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) PL_sub_generation++; CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv); - CvFILEGV(GvCV(gv)) = PL_curcop->cop_filegv; + CvFILE(GvCV(gv)) = CopFILE(PL_curcop); CvSTASH(GvCV(gv)) = PL_curstash; #ifdef USE_THREADS CvOWNER(GvCV(gv)) = 0; @@ -137,7 +139,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) } STATIC void -gv_init_sv(pTHX_ GV *gv, I32 sv_type) +S_gv_init_sv(pTHX_ GV *gv, I32 sv_type) { switch (sv_type) { case SVt_PVIO: @@ -152,6 +154,27 @@ gv_init_sv(pTHX_ GV *gv, I32 sv_type) } } +/* +=for apidoc gv_fetchmeth + +Returns the glob with the given C and a defined subroutine or +C. The glob lives in the given C, or in the stashes +accessible via @ISA and @UNIVERSAL. + +The argument C should be either 0 or -1. If C, as a +side-effect creates a glob with the given C in the given C +which in the case of success contains an alias for the subroutine, and sets +up caching info for this glob. Similarly for all the searched stashes. + +This function grants C<"SUPER"> token as a postfix of the stash name. The +GV returned from C may be a method cache entry, which is not +visible to Perl code. So when calling C, you should not use +the GV directly; instead, you should use the method's CV, which can be +obtained from the GV with the C macro. + +=cut +*/ + GV * Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) { @@ -164,10 +187,10 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) if (!stash) return 0; if ((level > 100) || (level < -100)) - croak("Recursive inheritance detected while looking for method '%s' in package '%s'", + Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'", name, HvNAME(stash)); - DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) ); + DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,HvNAME(stash)) ); gvp = (GV**)hv_fetch(stash, name, len, (level >= 0)); if (!gvp) @@ -207,7 +230,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) dTHR; /* just for SvREFCNT_dec */ gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE); if (!gvp || !(gv = *gvp)) - croak("Cannot create %s::ISA", HvNAME(stash)); + Perl_croak(aTHX_ "Cannot create %s::ISA", HvNAME(stash)); if (SvTYPE(gv) != SVt_PVGV) gv_init(gv, stash, "ISA", 3, TRUE); SvREFCNT_dec(GvAV(gv)); @@ -226,7 +249,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) if (!basestash) { dTHR; /* just for ckWARN */ if (ckWARN(WARN_MISC)) - warner(WARN_MISC, "Can't locate package %s for @%s::ISA", + Perl_warner(aTHX_ WARN_MISC, "Can't locate package %s for @%s::ISA", SvPVX(sv), HvNAME(stash)); continue; } @@ -273,12 +296,48 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) return 0; } +/* +=for apidoc gv_fetchmethod + +See L. + +=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 +on the C. In fact in the presence of autoloading this may be the +glob for "AUTOLOAD". In this case the corresponding variable $AUTOLOAD is +already setup. + +The third parameter of C determines whether +AUTOLOAD lookup is performed if the given method is not present: non-zero +means yes, look for AUTOLOAD; zero means no, don't look for AUTOLOAD. +Calling C is equivalent to calling C +with a non-zero C parameter. + +These functions grant C<"SUPER"> token as a prefix of the method name. Note +that if you want to keep the returned glob for a long time, you need to +check for it being "AUTOLOAD", since at the later time the call may load a +different subroutine due to $AUTOLOAD changing its value. Use the glob +created via a side effect to do this. + +These functions have the same side-effects and as C with +C. C should be writable if contains C<':'> or C<' +''>. The warning against passing the GV returned by C to +C apply equally to these functions. + +=cut +*/ + GV * Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) { @@ -300,10 +359,10 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) --nsplit; if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) { /* ->SUPER::method should really be looked up in original stash */ - SV *tmpstr = sv_2mortal(newSVpvf("%s::SUPER", - HvNAME(PL_curcop->cop_stash))); + SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER", + CopSTASHPV(PL_curcop))); stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE); - DEBUG_o( deb("Treating %s as %s::%s\n", + DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n", origname, HvNAME(stash), name) ); } else @@ -363,7 +422,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) */ if (ckWARN(WARN_DEPRECATED) && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash)) - warner(WARN_DEPRECATED, + Perl_warner(aTHX_ WARN_DEPRECATED, "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", HvNAME(stash), (int)len, name); @@ -385,6 +444,17 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) return gv; } +/* +=for apidoc gv_stashpv + +Returns a pointer to the stash for a specified package. If C is +set then the package will be created if it does not already exist. If +C is not set and the package does not exist then NULL is +returned. + +=cut +*/ + HV* Perl_gv_stashpv(pTHX_ const char *name, I32 create) { @@ -420,6 +490,15 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create) return stash; } +/* +=for apidoc gv_stashsv + +Returns a pointer to the stash for a specified package. See +C. + +=cut +*/ + HV* Perl_gv_stashsv(pTHX_ SV *sv, I32 create) { @@ -446,8 +525,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) name++; for (namend = name; *namend; namend++) { - if ((*namend == '\'' && namend[1]) || - (*namend == ':' && namend[1] == ':')) + if ((*namend == ':' && namend[1] == ':') + || (*namend == '\'' && namend[1])) { if (!stash) stash = PL_defstash; @@ -502,9 +581,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) /* No stash in name, so see how we can default */ if (!stash) { - if (isIDFIRST(*name) - || (IN_UTF8 && ((*name & 0xc0) == 0xc0) && isIDFIRST_utf8((U8*)name))) - { + if (isIDFIRST_lazy(name)) { bool global = FALSE; if (isUPPER(*name)) { @@ -548,18 +625,18 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp) || sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp) ) { - warn("Variable \"%c%s\" is not imported", + Perl_warn(aTHX_ "Variable \"%c%s\" is not imported", sv_type == SVt_PVAV ? '@' : sv_type == SVt_PVHV ? '%' : '$', name); if (GvCVu(*gvp)) - warn("(Did you mean &%s instead?)\n", name); + Perl_warn(aTHX_ "(Did you mean &%s instead?)\n", name); stash = 0; } } } else - stash = PL_curcop->cop_stash; + stash = CopSTASH(PL_curcop); } else stash = PL_defstash; @@ -568,26 +645,15 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) /* By this point we should have a stash and a name */ if (!stash) { - if (!add) - return Nullgv; - { - char sv_type_char = ((sv_type == SVt_PV) ? '$' - : (sv_type == SVt_PVAV) ? '@' - : (sv_type == SVt_PVHV) ? '%' - : 0); - if (sv_type_char) - warn("Global symbol \"%c%s\" requires explicit package name", - sv_type_char, name); - else - warn("Global symbol \"%s\" requires explicit package name", - name); + if (add) { + qerror(Perl_mess(aTHX_ + "Global symbol \"%s%s\" requires explicit package name", + (sv_type == SVt_PV ? "$" + : sv_type == SVt_PVAV ? "@" + : sv_type == SVt_PVHV ? "%" + : ""), name)); } - ++PL_error_count; - stash = PL_curstash ? PL_curstash : PL_defstash; /* avoid core dumps */ - add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV - : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV - : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV - : 0); + return Nullgv; } if (!SvREFCNT(stash)) /* symbol table under destruction */ @@ -609,12 +675,15 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) /* Adding a new symbol */ - if (add & GV_ADDWARN) - warn("Had to create %s unexpectedly", nambeg); + if (add & GV_ADDWARN && ckWARN_d(WARN_INTERNAL)) + Perl_warner(aTHX_ WARN_INTERNAL, "Had to create %s unexpectedly", nambeg); gv_init(gv, stash, name, len, add & GV_ADDMULTI); gv_init_sv(gv, sv_type); GvFLAGS(gv) |= add_gvflags; + if (isLEXWARN_on && isALPHA(name[0]) && ! ckWARN(WARN_ONCE)) + GvMULTI_on(gv) ; + /* set up magic where warranted */ switch (*name) { case 'A': @@ -660,39 +729,44 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (strEQ(name, "SIG")) { HV *hv; I32 i; - PL_siggv = gv; - GvMULTI_on(PL_siggv); - hv = GvHVn(PL_siggv); - hv_magic(hv, PL_siggv, 'S'); - for(i=1;PL_sig_name[i];i++) { + if (!PL_psig_ptr) { + int sig_num[] = { SIG_NUM }; + New(73, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*); + New(73, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*); + } + GvMULTI_on(gv); + hv = GvHVn(gv); + hv_magic(hv, gv, 'S'); + for (i = 1; PL_sig_name[i]; i++) { SV ** init; - init=hv_fetch(hv,PL_sig_name[i],strlen(PL_sig_name[i]),1); - if(init) - sv_setsv(*init,&PL_sv_undef); + 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; PL_psig_name[i] = 0; } } break; + case 'V': + if (strEQ(name, "VERSION")) + GvMULTI_on(gv); + break; case '&': if (len > 1) break; - PL_ampergv = gv; PL_sawampersand = TRUE; goto ro_magicalize; case '`': if (len > 1) break; - PL_leftgv = gv; PL_sawampersand = TRUE; goto ro_magicalize; case '\'': if (len > 1) break; - PL_rightgv = gv; PL_sawampersand = TRUE; goto ro_magicalize; @@ -715,14 +789,14 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) break; if (sv_type > SVt_PV && PL_curcop != &PL_compiling) { HV* stash = gv_stashpvn("Errno",5,FALSE); - if(!stash || !(gv_fetchmethod(stash, "TIEHASH"))) { + if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) { dSP; PUTBACK; - perl_require_pv("Errno.pm"); + require_pv("Errno.pm"); SPAGAIN; stash = gv_stashpvn("Errno",5,FALSE); if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) - croak("Can't use %%! because Errno.pm is not available"); + Perl_croak(aTHX_ "Can't use %%! because Errno.pm is not available"); } } goto magicalize; @@ -737,7 +811,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) case '#': case '*': if (ckWARN(WARN_DEPRECATED) && len == 1 && sv_type == SVt_PV) - warner(WARN_DEPRECATED, "Use of $%s is deprecated", name); + Perl_warner(aTHX_ WARN_DEPRECATED, "Use of $%s is deprecated", name); /* FALL THROUGH */ case '[': case '^': @@ -753,25 +827,28 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) case '\\': case '/': case '|': - case '\001': - case '\002': - case '\003': - case '\004': - case '\005': - case '\006': - case '\010': - case '\011': /* NOT \t in EBCDIC */ - case '\017': - case '\020': - case '\024': - case '\027': + case '\001': /* $^A */ + case '\003': /* $^C */ + case '\004': /* $^D */ + case '\005': /* $^E */ + case '\006': /* $^F */ + case '\010': /* $^H */ + case '\011': /* $^I, NOT \t in EBCDIC */ + case '\017': /* $^O */ + case '\020': /* $^P */ + case '\024': /* $^T */ if (len > 1) break; goto magicalize; - case '\023': + case '\023': /* $^S */ if (len > 1) break; goto ro_magicalize; + case '\027': /* $^W & $^WARNING_BITS */ + if (len > 1 && strNE(name, "\027ARNING_BITS") + && strNE(name, "\027IDE_SYSTEM_CALLS")) + break; + goto magicalize; case '+': if (len > 1) @@ -796,7 +873,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) sv_magic(GvSV(gv), (SV*)gv, 0, name, len); break; - case '\014': + case '\014': /* $^L */ if (len > 1) break; sv_setpv(GvSV(gv),"\f"); @@ -811,11 +888,19 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (len == 1) { SV *sv = GvSV(gv); (void)SvUPGRADE(sv, SVt_PVNV); - sv_setpv(sv, PL_patchlevel); - (void)sv_2nv(sv); + SvNVX(sv) = SvNVX(PL_patchlevel); + SvNOK_on(sv); + (void)SvPV_nolen(sv); SvREADONLY_on(sv); } break; + case '\026': /* $^V */ + if (len == 1) { + SV *sv = GvSV(gv); + GvSV(gv) = SvREFCNT_inc(PL_patchlevel); + SvREFCNT_dec(sv); + } + break; } return gv; } @@ -884,7 +969,6 @@ Perl_gv_check(pTHX_ HV *stash) register I32 i; register GV *gv; HV *hv; - GV *filegv; if (!HvARRAY(stash)) return; @@ -897,15 +981,26 @@ Perl_gv_check(pTHX_ HV *stash) gv_check(hv); /* nested package */ } else if (isALPHA(*HeKEY(entry))) { + char *file; gv = (GV*)HeVAL(entry); if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv)) continue; - PL_curcop->cop_line = GvLINE(gv); - filegv = GvFILEGV(gv); - PL_curcop->cop_filegv = filegv; - if (filegv && GvMULTI(filegv)) /* Filename began with slash */ + 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) + && (instr(file, "/lib/") || instr(file, ".pm"))) + { continue; - warner(WARN_ONCE, + } + CopLINE_set(PL_curcop, GvLINE(gv)); +#ifdef USE_ITHREADS + CopFILE(PL_curcop) = file; /* set for warning */ +#else + CopFILEGV(PL_curcop) = gv_fetchfile(file); +#endif + Perl_warner(aTHX_ WARN_ONCE, "Name \"%s::%s\" used only once: possible typo", HvNAME(stash), GvNAME(gv)); } @@ -916,7 +1011,7 @@ Perl_gv_check(pTHX_ HV *stash) GV * Perl_newGVgen(pTHX_ char *pack) { - return gv_fetchpv(form("%s::_GEN_%ld", pack, (long)PL_gensym++), + return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++), TRUE, SVt_PVGV); } @@ -925,6 +1020,8 @@ Perl_newGVgen(pTHX_ char *pack) GP* Perl_gp_ref(pTHX_ GP *gp) { + if (!gp) + return (GP*)NULL; gp->gp_refcnt++; if (gp->gp_cv) { if (gp->gp_cvgen) { @@ -944,13 +1041,16 @@ Perl_gp_ref(pTHX_ GP *gp) void Perl_gp_free(pTHX_ GV *gv) { + dTHR; GP* gp; CV* cv; if (!gv || !(gp = GvGP(gv))) return; if (gp->gp_refcnt == 0) { - warn("Attempt to free unreferenced glob pointers"); + if (ckWARN_d(WARN_INTERNAL)) + Perl_warner(aTHX_ WARN_INTERNAL, + "Attempt to free unreferenced glob pointers"); return; } if (gp->gp_cv) { @@ -1026,7 +1126,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) } sv_unmagic((SV*)stash, 'c'); - DEBUG_o( deb("Recalcing overload magic in package %s\n",HvNAME(stash)) ); + DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME(stash)) ); amt.was_ok_am = PL_amagic_generation; amt.was_ok_sub = PL_sub_generation; @@ -1069,7 +1169,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) /* FALL THROUGH */ case SVt_PVHV: case SVt_PVAV: - croak("Not a subroutine reference in overload table"); + Perl_croak(aTHX_ "Not a subroutine reference in overload table"); return FALSE; case SVt_PVCV: cv = (CV*)sv; @@ -1081,7 +1181,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) } if (cv) filled=1; else { - croak("Method for operation %s not found in package %.256s during blessing\n", + Perl_croak(aTHX_ "Method for operation %s not found in package %.256s during blessing\n", cp,HvNAME(stash)); return FALSE; } @@ -1107,8 +1207,8 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) } for (i = 1; i < NofAMmeth; i++) { - SV *cookie = sv_2mortal(newSVpvf("(%s", cp = PL_AMG_names[i])); - DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n", + SV *cookie = sv_2mortal(Perl_newSVpvf(aTHX_ "(%s", cp = PL_AMG_names[i])); + DEBUG_o( Perl_deb(aTHX_ "Checking overloading of `%s' in package `%.256s'\n", cp, HvNAME(stash)) ); /* don't fill the cache while looking up! */ gv = gv_fetchmeth(stash, SvPVX(cookie), SvCUR(cookie), -1); @@ -1119,7 +1219,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) /* GvSV contains the name of the method. */ GV *ngv; - DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", + DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) ); if (!SvPOK(GvSV(gv)) || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)), @@ -1127,17 +1227,17 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) { /* Can be an import stub (created by `can'). */ if (GvCVGEN(gv)) { - croak("Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", + Perl_croak(aTHX_ "Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ), cp, HvNAME(stash)); } else - croak("Can't resolve method `%.256s' overloading `%s' in package `%.256s'", + Perl_croak(aTHX_ "Can't resolve method `%.256s' overloading `%s' in package `%.256s'", (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ), cp, HvNAME(stash)); } cv = GvCV(gv = ngv); } - DEBUG_o( deb("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(stash), HvNAME(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv))) ); filled = 1; @@ -1327,7 +1427,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } else { SV *msg; if (off==-1) off=method; - msg = sv_2mortal(newSVpvf( + msg = sv_2mortal(Perl_newSVpvf(aTHX_ "Operation `%s': no method found,%sargument %s%s%s%s", PL_AMG_names[method + assignshift], (flags & AMGf_unary ? " " : "\n\tleft "), @@ -1346,9 +1446,9 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) HvNAME(SvSTASH(SvRV(right))): "")); if (amtp && amtp->fallback >= AMGfallYES) { - DEBUG_o( deb("%s", SvPVX(msg)) ); + DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX(msg)) ); } else { - croak("%_", msg); + Perl_croak(aTHX_ "%"SVf, msg); } return NULL; } @@ -1356,7 +1456,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } } if (!notfound) { - DEBUG_o( deb( + DEBUG_o( Perl_deb(aTHX_ "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n", PL_AMG_names[off], method+assignshift==off? "" : @@ -1415,7 +1515,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) if (PERLDB_SUB && PL_curstash != PL_debstash) PL_op->op_private |= OPpENTERSUB_DB; PUTBACK; - pp_pushmark(ARGS); + pp_pushmark(); EXTEND(SP, notfound + 5); PUSHs(lr>0? right: left); @@ -1427,8 +1527,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) PUSHs((SV*)cv); PUTBACK; - if (PL_op = pp_entersub(ARGS)) - CALLRUNOPS(); + if (PL_op = Perl_pp_entersub(aTHX)) + CALLRUNOPS(aTHX); LEAVE; SPAGAIN; @@ -1462,12 +1562,12 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) case dec_amg: SvSetSV(left,res); return left; case not_amg: - ans=!SvOK(res); break; + ans=!SvTRUE(res); break; } return boolSV(ans); } else if (method==copy_amg) { if (!SvROK(res)) { - croak("Copy method did not return a reference"); + Perl_croak(aTHX_ "Copy method did not return a reference"); } return SvREFCNT_inc(SvRV(res)); } else {