perldelta for #112962, reg_temp_copy and null offs

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 3ddf5e2..8ef1df7 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -438,20 +438,29 @@ PP(pp_warn)
     }
     else {
        exsv = TOPs;
+       if (SvGMAGICAL(exsv)) exsv = sv_mortalcopy(exsv);
     }
 
     if (SvROK(exsv) || (SvPV_const(exsv, len), len)) {
        /* well-formed exception supplied */
     }
-    else if (SvROK(ERRSV)) {
-       exsv = ERRSV;
-    }
-    else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
-       exsv = sv_mortalcopy(ERRSV);
-       sv_catpvs(exsv, "\t...caught");
-    }
     else {
+      SvGETMAGIC(ERRSV);
+      if (SvROK(ERRSV)) {
+       if (SvGMAGICAL(ERRSV)) {
+           exsv = sv_newmortal();
+           sv_setsv_nomg(exsv, ERRSV);
+       }
+       else exsv = ERRSV;
+      }
+      else if (SvPOKp(ERRSV) ? SvCUR(ERRSV) : SvNIOKp(ERRSV)) {
+       exsv = sv_newmortal();
+       sv_setsv_nomg(exsv, ERRSV);
+       sv_catpvs(exsv, "\t...caught");
+      }
+      else {
        exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
+      }
     }
     if (SvROK(exsv) && !PL_warnhook)
         Perl_warn(aTHX_ "%"SVf, SVfARG(exsv));
@@ -1370,7 +1379,7 @@ PP(pp_enterwrite)
        DIE(aTHX_ "Undefined format \"%"SVf"\" called", SVfARG(tmpsv));
     }
     IoFLAGS(io) &= ~IOf_DIDTOP;
-    return doform(cv,gv,PL_op->op_next);
+    RETURNOP(doform(cv,gv,PL_op->op_next));
 }
 
 PP(pp_leavewrite)
@@ -1385,6 +1394,12 @@ PP(pp_leavewrite)
     register PERL_CONTEXT *cx;
     OP *retop;
 
+    /* I'm not sure why, but executing the format leaves an extra value on the
+     * stack. There's probably a better place to be handling this (probably
+     * by avoiding pushing it in the first place!) but I don't quite know
+     * where to look. -doy */
+    (void)POPs;
+
     if (!io || !(ofp = IoOFP(io)))
         goto forget_top;
 
@@ -1454,7 +1469,7 @@ PP(pp_leavewrite)
            gv_efullname4(sv, fgv, NULL, FALSE);
            DIE(aTHX_ "Undefined top format \"%"SVf"\" called", SVfARG(sv));
        }
-       return doform(cv, gv, PL_op);
+       RETURNOP(doform(cv, gv, PL_op));
     }
 
   forget_top:
@@ -1488,10 +1503,9 @@ PP(pp_leavewrite)
     }
     /* bad_ofp: */
     PL_formtarget = PL_bodytarget;
-    PUTBACK;
     PERL_UNUSED_VAR(newsp);
     PERL_UNUSED_VAR(gimme);
-    return retop;
+    RETURNOP(retop);
 }
 
 PP(pp_prtf)