This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regen/regcharclass.pl: Comment, white-space only
[perl5.git] / pp_ctl.c
index e13e450..0260a87 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -696,6 +696,7 @@ PP(pp_formline)
 
        case FF_LINESNGL: /* process ^*  */
            chopspace = 0;
+            /* FALLTHROUGH */
 
        case FF_LINEGLOB: /* process @*  */
            {
@@ -1184,25 +1185,33 @@ PP(pp_flop)
        SvGETMAGIC(right);
 
        if (RANGE_IS_NUMERIC(left,right)) {
-           IV i, j;
-           IV max;
+           IV i, j, n;
            if ((SvOK(left) && !SvIOK(left) && SvNV_nomg(left) < IV_MIN) ||
                (SvOK(right) && (SvIOK(right)
                                 ? SvIsUV(right) && SvUV(right) > IV_MAX
                                 : SvNV_nomg(right) > IV_MAX)))
                DIE(aTHX_ "Range iterator outside integer range");
            i = SvIV_nomg(left);
-           max = SvIV_nomg(right);
-           if (max >= i) {
-               j = max - i + 1;
-               if (j > SSize_t_MAX)
-                   Perl_croak(aTHX_ "Out of memory during list extend");
-               EXTEND_MORTAL(j);
-               EXTEND(SP, j);
+           j = SvIV_nomg(right);
+           if (j >= i) {
+                /* Dance carefully around signed max. */
+                bool overflow = (i <= 0 && j > SSize_t_MAX + i - 1);
+                if (!overflow) {
+                    n = j - i + 1;
+                    /* The wraparound of signed integers is undefined
+                     * behavior, but here we aim for count >=1, and
+                     * negative count is just wrong. */
+                    if (n < 1)
+                        overflow = TRUE;
+                }
+                if (overflow)
+                    Perl_croak(aTHX_ "Out of memory during list extend");
+               EXTEND_MORTAL(n);
+               EXTEND(SP, n);
            }
            else
-               j = 0;
-           while (j--) {
+               n = 0;
+           while (n--) {
                SV * const sv = sv_2mortal(newSViv(i++));
                PUSHs(sv);
            }
@@ -1400,6 +1409,7 @@ S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
              * code block. Hide this faked entry from the world. */
             if (cx->cx_type & CXp_SUB_RE_FAKE)
                 continue;
+            /* FALLTHROUGH */
        case CXt_EVAL:
        case CXt_FORMAT:
            DEBUG_l( Perl_deb(aTHX_ "(dopoptosub_at(): found sub at cx=%ld)\n", (long)i));
@@ -1847,9 +1857,16 @@ PP(pp_caller)
     if (CxTYPE(cx) == CXt_EVAL) {
        /* eval STRING */
        if (CxOLD_OP_TYPE(cx) == OP_ENTEREVAL) {
-           PUSHs(newSVpvn_flags(SvPVX(cx->blk_eval.cur_text),
-                                SvCUR(cx->blk_eval.cur_text)-2,
-                                SvUTF8(cx->blk_eval.cur_text)|SVs_TEMP));
+            SV *cur_text = cx->blk_eval.cur_text;
+            if (SvCUR(cur_text) >= 2) {
+                PUSHs(newSVpvn_flags(SvPVX(cur_text), SvCUR(cur_text)-2,
+                                     SvUTF8(cur_text)|SVs_TEMP));
+            }
+            else {
+                /* I think this is will always be "", but be sure */
+                PUSHs(sv_2mortal(newSVsv(cur_text)));
+            }
+
            PUSHs(&PL_sv_no);
        }
        /* require */
@@ -3026,7 +3043,7 @@ PP(pp_goto) /* also pp_dump */
                    gotoprobe = CvROOT(cx->blk_sub.cv);
                    break;
                }
-               /* FALL THROUGH */
+               /* FALLTHROUGH */
            case CXt_FORMAT:
            case CXt_NULL:
                DIE(aTHX_ "Can't \"goto\" out of a pseudo block");
@@ -3081,7 +3098,7 @@ PP(pp_goto) /* also pp_dump */
            I32 oldsave;
 
            if (ix < 0)
-               ix = 0;
+               DIE(aTHX_ "panic: docatch: illegal ix=%ld", (long)ix);
            dounwind(ix);
            TOPBLOCK(cx);
            oldsave = PL_scopestack[PL_scopestack_ix];
@@ -3226,7 +3243,7 @@ S_docatch(pTHX_ OP *o)
            PL_restartop = 0;
            goto redo_body;
        }
-       /* FALL THROUGH */
+       /* FALLTHROUGH */
     default:
        JMPENV_POP;
        PL_op = oldop;
@@ -5206,7 +5223,7 @@ S_doparseform(pTHX_ SV *sv)
                s++;
            }
            noblank = TRUE;
-           /* FALL THROUGH */
+           /* FALLTHROUGH */
        case ' ': case '\t':
            skipspaces++;
            continue;