handy.h: add strEQs() and strNEs() for comparing to constant strings

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 0e31e73..36b68b6 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -104,18 +104,6 @@ PP(pp_regcomp)
     assert (re != (REGEXP*) &PL_sv_undef);
     eng = re ? RX_ENGINE(re) : current_re_engine();
 
-    /*
-     In the below logic: these are basically the same - check if this regcomp is part of a split.
-
-    (PL_op->op_pmflags & PMf_split )
-    (PL_op->op_next->op_type == OP_PUSHRE)
-
-    We could add a new mask for this and copy the PMf_split, if we did
-    some bit definition fiddling first.
-
-    For now we leave this
-    */
-
     new_re = (eng->op_comp
                    ? eng->op_comp
                    : &Perl_re_op_compile
@@ -927,6 +915,7 @@ PP(pp_formline)
     }
 }
 
+/* also used for: pp_mapstart() */
 PP(pp_grepstart)
 {
     dSP;
@@ -1598,12 +1587,17 @@ Perl_qerror(pTHX_ SV *err)
 static void
 S_pop_eval_context_maybe_croak(pTHX_ PERL_CONTEXT *cx, SV *errsv, int action)
 {
-    SV  *namesv;
+    SV  *namesv = NULL; /* init to avoid dumb compiler warning */
     bool do_croak;
 
     CX_LEAVE_SCOPE(cx);
     do_croak = action && (CxOLD_OP_TYPE(cx) == OP_REQUIRE);
-    namesv = cx->blk_eval.old_namesv;
+    if (do_croak) {
+        /* keep namesv alive after cx_popeval() */
+        namesv = cx->blk_eval.old_namesv;
+        cx->blk_eval.old_namesv = NULL;
+        sv_2mortal(namesv);
+    }
     cx_popeval(cx);
     cx_popblock(cx);
     CX_POP(cx);
@@ -1631,17 +1625,26 @@ S_pop_eval_context_maybe_croak(pTHX_ PERL_CONTEXT *cx, SV *errsv, int action)
 }
 
 
+/* die_unwind(): this is the final destination for the various croak()
+ * functions. If we're in an eval, unwind the context and other stacks
+ * back to the top-most CXt_EVAL and set $@ to msv; otherwise print msv
+ * to STDERR and initiate an exit. Note that if the CXt_EVAL popped back
+ * to is a require the exception will be rethrown, as requires don't
+ * actually trap exceptions.
+ */
 
 void
 Perl_die_unwind(pTHX_ SV *msv)
 {
-    SV *exceptsv = sv_mortalcopy(msv);
+    SV *exceptsv = msv;
     U8 in_eval = PL_in_eval;
     PERL_ARGS_ASSERT_DIE_UNWIND;
 
     if (in_eval) {
        I32 cxix;
 
+        exceptsv = sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
+
        /*
         * Historically, perl used to set ERRSV ($@) early in the die
         * process and rely on it not getting clobbered during unwinding.
@@ -1671,10 +1674,9 @@ Perl_die_unwind(pTHX_ SV *msv)
         * perls 5.13.{1..7} which had late setting of $@ without this
         * early-setting hack.
         */
-       if (!(in_eval & EVAL_KEEPERR)) {
-           SvTEMP_off(exceptsv);
-           sv_setsv(ERRSV, exceptsv);
-       }
+       if (!(in_eval & EVAL_KEEPERR))
+           sv_setsv_flags(ERRSV, exceptsv,
+                        (SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL));
 
        if (in_eval & EVAL_KEEPERR) {
            Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %"SVf,
@@ -2234,21 +2236,21 @@ PP(pp_leaveloop)
 {
     PERL_CONTEXT *cx;
     U8 gimme;
+    SV **base;
     SV **oldsp;
-    SV **mark;
 
     cx = CX_CUR();
     assert(CxTYPE_is_LOOP(cx));
-    mark = PL_stack_base + cx->blk_oldsp;
-    oldsp = CxTYPE(cx) == CXt_LOOP_LIST
+    oldsp = PL_stack_base + cx->blk_oldsp;
+    base = CxTYPE(cx) == CXt_LOOP_LIST
                 ? PL_stack_base + cx->blk_loop.state_u.stack.basesp
-                : mark;
+                : oldsp;
     gimme = cx->blk_gimme;
 
     if (gimme == G_VOID)
-        PL_stack_sp = oldsp;
+        PL_stack_sp = base;
     else
-        leave_adjust_stacks(MARK, oldsp, gimme,
+        leave_adjust_stacks(oldsp, base, gimme,
                                 PL_op->op_private & OPpLVALUE ? 3 : 1);
 
     CX_LEAVE_SCOPE(cx);