break;
case 'C':
if (strEQ(elem, "CODE"))
- ref = (SV*)GvCV(gv);
+ ref = (SV*)GvCVu(gv);
break;
case 'F':
if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
PP(pp_preinc)
{
dSP;
+ if (SvREADONLY(TOPs))
+ croak(no_modify);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MAX)
{
PP(pp_pushre)
{
dSP;
+#ifdef DEBUGGING
+ /*
+ * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
+ * will be enough to hold an OP*.
+ */
+ SV* sv = sv_newmortal();
+ sv_upgrade(sv, SVt_PVLV);
+ LvTYPE(sv) = '/';
+ Copy(&op, &LvTARGOFF(sv), 1, OP*);
+ XPUSHs(sv);
+#else
XPUSHs((SV*)op);
+#endif
RETURN;
}
magic = SvMAGICAL(ary) != 0;
av_clear(ary);
+ av_extend(ary, lastrelem - relem);
i = 0;
while (relem <= lastrelem) { /* gobble up all the rest */
sv = NEWSV(28,0);
perl_call_method("READLINE", GIMME);
LEAVE;
SPAGAIN;
- if (GIMME == G_SCALAR) sv_setsv(TARG, TOPs);
+ if (GIMME == G_SCALAR)
+ SvSetSV_nosteal(TARG, TOPs);
RETURN;
}
fp = Nullfp;
register CONTEXT *cx;
I32 gimme;
bool hasargs = (op->op_flags & OPf_STACKED) != 0;
- bool may_clone = TRUE;
if (!sv)
DIE("Not a CODE reference");
break;
}
cv = (CV*)SvRV(sv);
- if (SvTYPE(cv) == SVt_PVCV) {
- may_clone = FALSE;
+ if (SvTYPE(cv) == SVt_PVCV)
break;
- }
/* FALL THROUGH */
case SVt_PVHV:
case SVt_PVAV:
DIE("Not a CODE reference");
case SVt_PVCV:
cv = (CV*)sv;
- may_clone = FALSE;
break;
case SVt_PVGV:
- if (!(cv = GvCV((GV*)sv)))
+ if (!(cv = GvCVu((GV*)sv)))
cv = sv_2cv(sv, &stash, &gv, TRUE);
break;
}
ENTER;
SAVETMPS;
- if (may_clone && cv && CvCLONE(cv))
- cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
-
retry:
if (!cv)
DIE("Not a CODE reference");
if (!CvROOT(cv) && !CvXSUB(cv)) {
- if (gv = CvGV(cv)) {
- SV *tmpstr;
- GV *ngv;
- if (SvFAKE(cv) && GvCV(gv) != cv) { /* autoloaded stub? */
- cv = GvCV(gv);
- if (SvTYPE(sv) == SVt_PVGV) {
- SvREFCNT_dec(GvCV((GV*)sv));
- GvCV((GV*)sv) = (CV*)SvREFCNT_inc((SV*)cv);
- }
- goto retry;
- }
- tmpstr = sv_newmortal();
- gv_efullname3(tmpstr, gv, Nullch);
- ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
- if (ngv && ngv != gv && (cv = GvCV(ngv))) { /* One more chance... */
- gv = ngv;
- sv_setsv(GvSV(CvGV(cv)), tmpstr); /* Set CV's $AUTOLOAD */
- SvTAINTED_off(GvSV(CvGV(cv)));
- goto retry;
- }
- else
- DIE("Undefined subroutine &%s called",SvPVX(tmpstr));
+ GV* autogv;
+ SV* subname;
+
+ /* anonymous or undef'd function leaves us no recourse */
+ if (CvANON(cv) || !(gv = CvGV(cv)))
+ DIE("Undefined subroutine called");
+ /* autoloaded stub? */
+ if (cv != GvCV(gv)) {
+ cv = GvCV(gv);
+ goto retry;
+ }
+ /* should call AUTOLOAD now? */
+ if ((autogv = gv_autoload(GvESTASH(gv), GvNAME(gv), GvNAMELEN(gv)))) {
+ cv = GvCV(autogv);
+ goto retry;
}
- DIE("Undefined subroutine called");
+ /* sorry */
+ subname = sv_newmortal();
+ gv_efullname3(subname, gv, Nullch);
+ DIE("Undefined subroutine &%s called", SvPVX(subname));
}
gimme = GIMME;
- if ((op->op_private & OPpENTERSUB_DB) && !CvNODEBUG(cv)) {
+ if ((op->op_private & OPpENTERSUB_DB) && GvCV(DBsub) && !CvNODEBUG(cv)) {
SV *oldsv = sv;
sv = GvSV(DBsub);
save_item(sv);
(void)SvREFCNT_inc(cv);
else { /* save temporaries on recursion? */
if (CvDEPTH(cv) == 100 && dowarn
- && !(perldb && cv == GvCV(DBsub)))
- warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv)));
+ && !(perldb && cv == GvCV(DBsub)))
+ sub_crush_depth(cv);
if (CvDEPTH(cv) > AvFILL(padlist)) {
AV *av;
AV *newpad = newAV();
}
}
+void
+sub_crush_depth(cv)
+CV* cv;
+{
+ if (CvANON(cv))
+ warn("Deep recursion on anonymous subroutine");
+ else {
+ SV* tmpstr = sv_newmortal();
+ gv_efullname3(tmpstr, CvGV(cv), Nullch);
+ warn("Deep recursion on subroutine \"%s\"", SvPVX(tmpstr));
+ }
+}
+
PP(pp_aelem)
{
dSP;
if (!gv)
DIE("Can't locate object method \"%s\" via package \"%s\"",
name, packname);
- SETs((SV*)gv);
+ SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
RETURN;
}
*(stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
name, HvNAME(SvSTASH(ob)));
}
- SETs((SV*)gv);
+ SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
RETURN;
}