[shell changes from patch from perl5.003_23 to perl5.003_24]

[p5sagit/p5-mst-13.2.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index f957deb..707239f 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -97,7 +97,7 @@ PP(pp_gelem)
        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 */
@@ -242,6 +242,8 @@ PP(pp_eq)
 PP(pp_preinc)
 {
     dSP;
+    if (SvREADONLY(TOPs))
+       croak(no_modify);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MAX)
     {
@@ -297,7 +299,19 @@ PP(pp_join)
 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;
 }
 
@@ -598,6 +612,7 @@ PP(pp_aassign)
            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);
@@ -957,7 +972,8 @@ do_readline()
        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;
@@ -1662,12 +1678,6 @@ PP(pp_leavesub)
                /* in case LEAVE wipes old return values */
     }
 
-    if (cx->blk_sub.hasargs) {         /* You don't exist; go away. */
-       AV* av = cx->blk_sub.argarray;
-
-       av_clear(av);
-       AvREAL_off(av);
-    }
     curpm = newpm;     /* Don't pop $1 et al till now */
 
     LEAVE;
@@ -1684,7 +1694,6 @@ PP(pp_entersub)
     register CONTEXT *cx;
     I32 gimme;
     bool hasargs = (op->op_flags & OPf_STACKED) != 0;
-    bool may_clone = TRUE;
 
     if (!sv)
        DIE("Not a CODE reference");
@@ -1704,20 +1713,17 @@ PP(pp_entersub)
            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;
     }
@@ -1725,42 +1731,35 @@ PP(pp_entersub)
     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;
        }
-       DIE("Undefined subroutine called");
+       /* should call AUTOLOAD now? */
+       if ((autogv = gv_autoload(GvESTASH(gv), GvNAME(gv), GvNAMELEN(gv)))) {
+           cv = GvCV(autogv);
+           goto retry;
+       }
+       /* sorry */
+       subname = sv_newmortal();
+       gv_efullname3(subname, gv, Nullch);
+       DIE("Undefined subroutine &%s called", SvPVX(subname));
     }
 
     gimme = GIMME;
-    if ((op->op_private & OPpENTERSUB_DB)) {
+    if ((op->op_private & OPpENTERSUB_DB) && GvCV(DBsub) && !CvNODEBUG(cv)) {
        SV *oldsv = sv;
        sv = GvSV(DBsub);
        save_item(sv);
@@ -1854,8 +1853,8 @@ PP(pp_entersub)
            (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();
@@ -1935,6 +1934,19 @@ PP(pp_entersub)
     }
 }
 
+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;
@@ -2035,7 +2047,7 @@ DIE("Can't call method \"%s\" without a package or object reference", name);
            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));
@@ -2054,7 +2066,7 @@ DIE("Can't call method \"%s\" without a package or object reference", name);
                name, HvNAME(SvSTASH(ob)));
     }
 
-    SETs((SV*)gv);
+    SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
     RETURN;
 }