embed.fnc: Functions in mathoms are deprecated

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 89eca4b..8d3097b 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.  */
@@ -1177,14 +1178,18 @@ PP(pp_flip)
 }
 
 /* This code tries to decide if "$left .. $right" should use the
-   magical string increment, or if the range is numeric (we make
-   an exception for .."0" [#18165]). AMS 20021031. */
+   magical string increment, or if the range is numeric. Initially,
+   an exception was made for *any* string beginning with "0" (see
+   [#18165], AMS 20021031), but now that is only applied when the
+   string's length is also >1 - see the rules now documented in
+   perlop [#133695] */
 
 #define RANGE_IS_NUMERIC(left,right) ( \
        SvNIOKp(left)  || (SvOK(left)  && !SvPOKp(left))  || \
        SvNIOKp(right) || (SvOK(right) && !SvPOKp(right)) || \
        (((!SvOK(left) && SvOK(right)) || ((!SvOK(left) || \
-          looks_like_number(left)) && SvPOKp(left) && *SvPVX_const(left) != '0')) \
+          looks_like_number(left)) && SvPOKp(left) \
+          && !(*SvPVX_const(left) == '0' && SvCUR(left)>1 ) )) \
          && (!SvOK(right) || looks_like_number(right))))
 
 PP(pp_flop)
@@ -1719,9 +1724,13 @@ 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))
+       if (!(in_eval & EVAL_KEEPERR)) {
+            /* remove any read-only/magic from the SV, so we don't
+               get infinite recursion when setting ERRSV */
+            SANE_ERRSV();
            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,
@@ -1783,8 +1792,10 @@ Perl_die_unwind(pTHX_ SV *msv)
              */
             S_pop_eval_context_maybe_croak(aTHX_ cx, exceptsv, 2);
 
-           if (!(in_eval & EVAL_KEEPERR))
+           if (!(in_eval & EVAL_KEEPERR)) {
+                SANE_ERRSV();
                sv_setsv(ERRSV, exceptsv);
+            }
            PL_restartjmpenv = restartjmpenv;
            PL_restartop = restartop;
            JMPENV_JUMP(3);
@@ -2676,6 +2687,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
          && 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))
@@ -2687,6 +2699,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
     *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) {
@@ -2709,6 +2722,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) {
@@ -2721,8 +2735,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;
@@ -4209,7 +4229,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, "::");
@@ -4218,14 +4238,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 */