This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Magic flags harmonization.
[perl5.git] / pp_ctl.c
index c55afb1..f2119a7 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -225,9 +225,9 @@ PP(pp_substcont)
            assert(cx->sb_strend >= s);
            if(cx->sb_strend > s) {
                 if (DO_UTF8(dstr) && !SvUTF8(targ))
-                     sv_catpvn_utf8_upgrade(dstr, s, cx->sb_strend - s, nsv);
+                     sv_catpvn_nomg_utf8_upgrade(dstr, s, cx->sb_strend - s, nsv);
                 else
-                     sv_catpvn(dstr, s, cx->sb_strend - s);
+                     sv_catpvn_nomg(dstr, s, cx->sb_strend - s);
            }
            if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
                cx->sb_rxtainted |= SUBST_TAINT_PAT;
@@ -296,9 +296,9 @@ PP(pp_substcont)
     cx->sb_m = m = RX_OFFS(rx)[0].start + orig;
     if (m > s) {
        if (DO_UTF8(dstr) && !SvUTF8(cx->sb_targ))
-           sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
+           sv_catpvn_nomg_utf8_upgrade(dstr, s, m - s, nsv);
        else
-           sv_catpvn(dstr, s, m-s);
+           sv_catpvn_nomg(dstr, s, m-s);
     }
     cx->sb_s = RX_OFFS(rx)[0].end + orig;
     { /* Update the pos() information. */
@@ -3245,8 +3245,16 @@ than in the scope of the debugger itself).
 CV*
 Perl_find_runcv(pTHX_ U32 *db_seqp)
 {
+    return Perl_find_runcv_where(aTHX_ 0, NULL, db_seqp);
+}
+
+/* If this becomes part of the API, it might need a better name. */
+CV *
+Perl_find_runcv_where(pTHX_ U8 cond, void *arg, U32 *db_seqp)
+{
     dVAR;
     PERL_SI     *si;
+    int                 level = 0;
 
     if (db_seqp)
        *db_seqp = PL_curcop->cop_seq;
@@ -3254,20 +3262,32 @@ Perl_find_runcv(pTHX_ U32 *db_seqp)
         I32 ix;
        for (ix = si->si_cxix; ix >= 0; ix--) {
            const PERL_CONTEXT *cx = &(si->si_cxstack[ix]);
+           CV *cv = NULL;
            if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
-               CV * const cv = cx->blk_sub.cv;
+               cv = cx->blk_sub.cv;
                /* skip DB:: code */
                if (db_seqp && PL_debstash && CvSTASH(cv) == PL_debstash) {
                    *db_seqp = cx->blk_oldcop->cop_seq;
                    continue;
                }
-               return cv;
            }
            else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
-               return cx->blk_eval.cv;
+               cv = cx->blk_eval.cv;
+           if (cv) {
+               switch (cond) {
+               case FIND_RUNCV_root_eq:
+                   if (CvROOT(cv) != (OP *)arg) continue;
+                   return cv;
+               case FIND_RUNCV_level_eq:
+                   if (level++ != PTR2IV(arg)) continue;
+                   /* GERONIMO! */
+               default:
+                   return cv;
+               }
+           }
        }
     }
-    return PL_main_cv;
+    return cond == FIND_RUNCV_root_eq ? NULL : PL_main_cv;
 }
 
 
@@ -3444,9 +3464,7 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
        PL_op = saveop;
        if (yystatus != 3) {
            if (PL_eval_root) {
-#ifndef PL_OP_SLAB_ALLOC
                cv_forget_slab(evalcv);
-#endif
                op_free(PL_eval_root);
                PL_eval_root = NULL;
            }
@@ -3489,9 +3507,7 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
 
     CopLINE_set(&PL_compiling, 0);
     SAVEFREEOP(PL_eval_root);
-#ifndef PL_OP_SLAB_ALLOC
     cv_forget_slab(evalcv);
-#endif
 
     DEBUG_x(dump_eval());