Add a new Porting/podtidy to reformat pod using Pod::Tidy

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

diff --git a/pp_hot.c b/pp_hot.c
index e602c87..f0c56cf 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -12,8 +12,10 @@
  * Then he heard Merry change the note, and up went the Horn-cry of Buckland,
  * shaking the air.
  *
- *            Awake!  Awake!  Fear, Fire, Foes!  Awake!
- *                     Fire, Foes!  Awake!
+ *                  Awake!  Awake!  Fear, Fire, Foes!  Awake!
+ *                               Fire, Foes!  Awake!
+ *
+ *     [p.1007 of _The Lord of the Rings_, VI/viii: "The Scouring of the Shire"]
  */
 
 /* This file contains 'hot' pp ("push/pop") functions that
@@ -398,7 +400,7 @@ PP(pp_preinc)
 {
     dVAR; dSP;
     if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
-       DIE(aTHX_ PL_no_modify);
+       DIE(aTHX_ "%s", PL_no_modify);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MAX)
     {
@@ -751,14 +753,16 @@ PP(pp_print)
        goto just_say_no;
     }
     else {
+       SV * const ofs = GvSV(PL_ofsgv); /* $, */
        MARK++;
-       if (PL_ofs_sv && SvOK(PL_ofs_sv)) {
+       if (ofs && (SvGMAGICAL(ofs) || SvOK(ofs))) {
            while (MARK <= SP) {
                if (!do_print(*MARK, fp))
                    break;
                MARK++;
                if (MARK <= SP) {
-                   if (!do_print(PL_ofs_sv, fp)) { /* $, */
+                   /* don't use 'ofs' here - it may be invalidated by magic callbacks */
+                   if (!do_print(GvSV(PL_ofsgv), fp)) {
                        MARK--;
                        break;
                    }
@@ -826,7 +830,7 @@ PP(pp_rv2av)
        }
        else if (PL_op->op_flags & OPf_MOD
                && PL_op->op_private & OPpLVAL_INTRO)
-           Perl_croak(aTHX_ PL_no_localize_ref);
+           Perl_croak(aTHX_ "%s", PL_no_localize_ref);
     }
     else {
        if (SvTYPE(sv) == type) {
@@ -946,7 +950,7 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
            }
            else
                err = "Odd number of elements in hash assignment";
-           Perl_warner(aTHX_ packWARN(WARN_MISC), err);
+           Perl_warner(aTHX_ packWARN(WARN_MISC), "%s", err);
        }
 
         tmpstr = newSV(0);
@@ -1750,9 +1754,13 @@ PP(pp_enter)
     I32 gimme = OP_GIMME(PL_op, -1);
 
     if (gimme == -1) {
-       if (cxstack_ix >= 0)
-           gimme = cxstack[cxstack_ix].blk_gimme;
-       else
+       if (cxstack_ix >= 0) {
+           /* If this flag is set, we're just inside a return, so we should
+            * store the caller's context */
+           gimme = (PL_op->op_flags & OPf_SPECIAL)
+               ? block_gimme()
+               : cxstack[cxstack_ix].blk_gimme;
+       } else
            gimme = G_SCALAR;
     }
 
@@ -1826,7 +1834,8 @@ PP(pp_helem)
                    SAVEDELETE(hv, savepvn(key,keylen),
                               SvUTF8(keysv) ? -(I32)keylen : (I32)keylen);
                } else
-                   save_helem(hv, keysv, svp);
+                   save_helem_flags(hv, keysv, svp,
+                                    (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC);
             }
        }
        else if (PL_op->op_private & OPpDEREF)
@@ -1860,13 +1869,7 @@ PP(pp_leave)
 
     POPBLOCK(cx,newpm);
 
-    gimme = OP_GIMME(PL_op, -1);
-    if (gimme == -1) {
-       if (cxstack_ix >= 0)
-           gimme = cxstack[cxstack_ix].blk_gimme;
-       else
-           gimme = G_SCALAR;
-    }
+    gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
 
     TAINT_NOT;
     if (gimme == G_VOID)
@@ -2097,7 +2100,7 @@ PP(pp_subst)
         || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
               || SvTYPE(TARG) > SVt_PVLV)
             && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
-       DIE(aTHX_ PL_no_modify);
+       DIE(aTHX_ "%s", PL_no_modify);
     PUTBACK;
 
     s = SvPV_mutable(TARG, len);
@@ -2422,7 +2425,7 @@ PP(pp_grepwhile)
        if (PL_op->op_private & OPpGREP_LEX)
            PAD_SVl(PL_op->op_targ) = src;
        else
-           DEFSV = src;
+           DEFSV_set(src);
 
        RETURNOP(cLOGOP->op_other);
     }
@@ -2769,7 +2772,14 @@ try_autoload:
         Perl_get_db_sub(aTHX_ &sv, cv);
         if (CvISXSUB(cv))
             PL_curcopdb = PL_curcop;
-        cv = GvCV(PL_DBsub);
+         if (CvLVALUE(cv)) {
+             /* check for lsub that handles lvalue subroutines */
+            cv = GvCV(gv_HVadd(gv_fetchpv("DB::lsub", GV_ADDMULTI, SVt_PVHV)));
+             /* if lsub not found then fall back to DB::sub */
+            if (!cv) cv = GvCV(PL_DBsub);
+         } else {
+             cv = GvCV(PL_DBsub);
+         }
 
        if (!cv || (!CvXSUB(cv) && !CvSTART(cv)))
            DIE(aTHX_ "No DB::sub routine defined");
@@ -2967,7 +2977,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
     SvGETMAGIC(sv);
     if (!SvOK(sv)) {
        if (SvREADONLY(sv))
-           Perl_croak(aTHX_ PL_no_modify);
+           Perl_croak(aTHX_ "%s", PL_no_modify);
        prepare_SV_for_RV(sv);
        switch (to_what) {
        case OPpDEREF_SV: