Typemap.xs: avoid leak

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 6e5f34d..a38b9c1 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -781,7 +781,8 @@ PP(pp_formline)
                         * for safety */
                        grow = linemax;
                        while (linemark--)
-                           s += UTF8SKIP(s);
+                           s += UTF8_SAFE_SKIP(s,
+                                            (U8 *) SvEND(PL_formtarget));
                        linemark = s - (U8*)SvPVX(PL_formtarget);
                    }
                    /* Easy. They agree.  */
@@ -2645,6 +2646,7 @@ PP(pp_redo)
 }
 
 #define UNENTERABLE (OP *)1
+#define GOTO_DEPTH 64
 
 STATIC OP *
 S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstack, OP **oplimit)
@@ -2665,24 +2667,29 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
     {
        *ops++ = cUNOPo->op_first;
     }
-    else if (o->op_flags & OPf_KIDS
+    else if (oplimit - opstack < GOTO_DEPTH) {
+      if (o->op_flags & OPf_KIDS
          && cUNOPo->op_first->op_type == OP_PUSHMARK) {
        *ops++ = UNENTERABLE;
-    }
-    else if (o->op_flags & OPf_KIDS && PL_opargs[o->op_type]
+      }
+      else if (o->op_flags & OPf_KIDS && PL_opargs[o->op_type]
          && OP_CLASS(o) != OA_LOGOP
          && o->op_type != OP_LINESEQ
          && o->op_type != OP_SREFGEN
+         && o->op_type != OP_ENTEREVAL
+         && o->op_type != OP_GLOB
          && o->op_type != OP_RV2CV) {
        OP * const kid = cUNOPo->op_first;
        if (OP_GIMME(kid, 0) != G_SCALAR || OpHAS_SIBLING(kid))
            *ops++ = UNENTERABLE;
+      }
     }
     if (ops >= oplimit)
        Perl_croak(aTHX_ "%s", too_deep);
     *ops = 0;
     if (o->op_flags & OPf_KIDS) {
        OP *kid;
+       OP * const kid1 = cUNOPo->op_first;
        /* First try all the kids at this level, since that's likeliest. */
        for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
            if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
@@ -2705,6 +2712,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
            }
        }
        for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
+           bool first_kid_of_binary = FALSE;
            if (kid == PL_lastgotoprobe)
                continue;
            if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
@@ -2717,8 +2725,14 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
                else
                    *ops++ = kid;
            }
+           if (kid == kid1 && ops != opstack && ops[-1] == UNENTERABLE) {
+               first_kid_of_binary = TRUE;
+               ops--;
+           }
            if ((o = dofindlabel(kid, label, len, flags, ops, oplimit)))
                return o;
+           if (first_kid_of_binary)
+               *ops++ = UNENTERABLE;
        }
     }
     *ops = 0;
@@ -2751,7 +2765,6 @@ PP(pp_goto)
     OP *retop = NULL;
     I32 ix;
     PERL_CONTEXT *cx;
-#define GOTO_DEPTH 64
     OP *enterops[GOTO_DEPTH];
     const char *label = NULL;
     STRLEN label_len = 0;
@@ -4206,7 +4219,7 @@ S_require_file(pTHX_ SV *sv)
                         }
 
                         if (c == e && isIDFIRST_lazy_if_safe(name, e, utf8)) {
-                            sv_catpv(msg, " (you may need to install the ");
+                            sv_catpvs(msg, " (you may need to install the ");
                             for (c = name; c < e; c++) {
                                 if (*c == '/') {
                                     sv_catpvs(msg, "::");
@@ -4215,14 +4228,14 @@ S_require_file(pTHX_ SV *sv)
                                     sv_catpvn(msg, c, 1);
                                 }
                             }
-                            sv_catpv(msg, " module)");
+                            sv_catpvs(msg, " module)");
                         }
                    }
                    else if (memENDs(name, len, ".h")) {
-                       sv_catpv(msg, " (change .h to .ph maybe?) (did you run h2ph?)");
+                       sv_catpvs(msg, " (change .h to .ph maybe?) (did you run h2ph?)");
                    }
                    else if (memENDs(name, len, ".ph")) {
-                       sv_catpv(msg, " (did you run h2ph?)");
+                       sv_catpvs(msg, " (did you run h2ph?)");
                    }
 
                    /* diag_listed_as: Can't locate %s */