This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Carthago delenda est
[perl5.git] / regexec.c
index 2d5bf0b..05675ad 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -126,13 +126,16 @@ static const char* const non_utf8_target_but_utf8_required
                     (U8*)(off >= 0 ? reginfo->strend : reginfo->strbeg)) \
            : (U8*)(pos + off))
 
-#define HOPBACKc(pos, off) \
-       (char*)(reginfo->is_utf8_target \
-           ? reghopmaybe3((U8*)pos, (SSize_t)0-off, (U8*)(reginfo->strbeg)) \
-           : (pos - off >= reginfo->strbeg)    \
-               ? (U8*)pos - off                \
+/* like HOPMAYBE3 but backwards. lim must be +ve. Returns NULL on overshoot */
+#define HOPBACK3(pos, off, lim) \
+       (reginfo->is_utf8_target                          \
+           ? reghopmaybe3((U8*)pos, (SSize_t)0-off, (U8*)(lim)) \
+           : (pos - off >= lim)                                 \
+               ? (U8*)pos - off                                 \
                : NULL)
 
+#define HOPBACKc(pos, off) ((char*)HOPBACK3(pos, off, reginfo->strbeg))
+
 #define HOP3(pos,off,lim) (reginfo->is_utf8_target  ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
 
@@ -884,7 +887,9 @@ Perl_re_intuit_start(pTHX_
                 (IV)prog->check_end_shift);
         });
         
-        end_point = HOP3(strend, -end_shift, strbeg);
+        end_point = HOPBACK3(strend, end_shift, rx_origin);
+        if (!end_point)
+            goto fail_finish;
         start_point = HOPMAYBE3(rx_origin, start_shift, end_point);
         if (!start_point)
             goto fail_finish;
@@ -4340,7 +4345,7 @@ S_isGCB(pTHX_ const GCB_enum before, const GCB_enum after, const U8 * const strb
                 /* Do not break within emoji flag sequences. That is, do not
                  * break between regional indicator (RI) symbols if there is an
                  * odd number of RI characters before the break point.
-                 *  GB12     ^ (RI RI)* RI × RI
+                 *  GB12   sot (RI RI)* RI × RI
                  *  GB13 [^RI] (RI RI)* RI × RI */
 
                 while (backup_one_GCB(strbeg,
@@ -4632,7 +4637,7 @@ S_isLB(pTHX_ LB_enum before,
                  * only if there are an even number of regional indicators
                  * preceding the position of the break.
                  *
-                 *  sot (RI RI)* RI × RI
+                 *    sot (RI RI)* RI × RI
                  *  [^RI] (RI RI)* RI × RI */
 
                 while (backup_one_LB(strbeg,
@@ -5162,7 +5167,7 @@ S_isWB(pTHX_ WB_enum previous,
                  * odd number of RI characters before the potential break
                  * point.
                  *
-                 * WB15     ^ (RI RI)* RI × RI
+                 * WB15   sot (RI RI)* RI × RI
                  * WB16 [^RI] (RI RI)* RI × RI */
 
                 while (backup_one_WB(&previous,
@@ -5391,7 +5396,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
     U8 gimme = G_SCALAR;
     CV *caller_cv = NULL;      /* who called us */
     CV *last_pushed_cv = NULL; /* most recently called (?{}) CV */
-    CHECKPOINT runops_cp;      /* savestack position before executing EVAL */
     U32 maxopenparen = 0;       /* max '(' index seen so far */
     int to_complement;  /* Invert the result? */
     _char_class_number classnum;
@@ -5594,6 +5598,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                 if (scan->flags == EXACTL || scan->flags == EXACTFLU8) {
                     _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
                     if (utf8_target
+                        && nextchr >= 0 /* guard against negative EOS value in nextchr */
                         && UTF8_IS_ABOVE_LATIN1(nextchr)
                         && scan->flags == EXACTL)
                     {
@@ -5737,6 +5742,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
         {
             U8 *uc;
             if ( ST.jump ) {
+                /* undo any captures done in the tail part of a branch,
+                 * e.g.
+                 *    /(?:X(.)(.)|Y(.)).../
+                 * where the trie just matches X then calls out to do the
+                 * rest of the branch */
                 REGCP_UNWIND(ST.cp);
                 UNWIND_PAREN(ST.lastparen, ST.lastcloseparen);
            }
@@ -6787,7 +6797,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
             goto eval_recurse_doit;
             /* NOTREACHED */
 
-        case EVAL:  /*   /(?{A})B/   /(??{A})B/  and /(?(?{A})X|Y)B/   */        
+        case EVAL:  /*   /(?{...})B/   /(??{A})B/  and  /(?(?{...})X|Y)B/   */
             if (cur_eval && cur_eval->locinput==locinput) {
                if ( ++nochange_depth > max_nochange_depth )
                     Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
@@ -6806,7 +6816,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
 
                /* save *all* paren positions */
                 regcppush(rex, 0, maxopenparen);
-               REGCP_SET(runops_cp);
+                REGCP_SET(ST.lastcp);
 
                if (!caller_cv)
                    caller_cv = find_runcv(NULL);
@@ -6834,7 +6844,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                 /* Some notes about MULTICALL and the context and save stacks.
                  *
                  * In something like
-                 *   /...(?{ my $x)}...(?{ my $z)}...(?{ my $z)}.../
+                 *   /...(?{ my $x)}...(?{ my $y)}...(?{ my $z)}.../
                  * since codeblocks don't introduce a new scope (so that
                  * local() etc accumulate), at the end of a successful
                  * match there will be a SAVEt_CLEARSV on the savestack
@@ -6869,7 +6879,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                  * *everything* SAVEd by this function is undone and then
                  * the context popped, rather than e.g., popping the
                  * context (and restoring the original PL_comppad) then
-                 * popping more of the savestack and restoiring a bad
+                 * popping more of the savestack and restoring a bad
                  * PL_comppad.
                  */
 
@@ -7008,12 +7018,14 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                 * in the regexp code uses the pad ! */
                PL_op = oop;
                PL_curcop = ocurcop;
-                regcp_restore(rex, runops_cp, &maxopenparen);
+                regcp_restore(rex, ST.lastcp, &maxopenparen);
                 PL_curpm_under = PL_curpm;
                 PL_curpm = PL_reg_curpm;
 
-               if (logical != 2)
-                   break;
+               if (logical != 2) {
+                    PUSH_STATE_GOTO(EVAL_B, next, locinput);
+                   /* NOTREACHED */
+                }
            }
 
                /* only /(??{})/  from now on */
@@ -7111,11 +7123,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                ST.prev_eval = cur_eval;
                cur_eval = st;
                /* now continue from first node in postoned RE */
-               PUSH_YES_STATE_GOTO(EVAL_AB, startpoint, locinput);
+               PUSH_YES_STATE_GOTO(EVAL_postponed_AB, startpoint, locinput);
                NOT_REACHED; /* NOTREACHED */
        }
 
-       case EVAL_AB: /* cleanup after a successful (??{A})B */
+       case EVAL_postponed_AB: /* cleanup after a successful (??{A})B */
             /* note: this is called twice; first after popping B, then A */
             DEBUG_STACK_r({
                 Perl_re_exec_indentf( aTHX_  "EVAL_AB cur_eval=%p prev_eval=%p\n",
@@ -7161,7 +7173,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
            sayYES;
 
 
-       case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
+       case EVAL_B_fail: /* unsuccessful B in (?{...})B */
+           REGCP_UNWIND(ST.lastcp);
+            sayNO;
+
+       case EVAL_postponed_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
            /* note: this is called twice; first after popping B, then A */
             DEBUG_STACK_r({
                 Perl_re_exec_indentf( aTHX_  "EVAL_AB_fail cur_eval=%p prev_eval=%p\n",
@@ -7561,9 +7577,6 @@ NULL
            if (cur_curlyx->u.curlyx.minmod) {
                ST.save_curlyx = cur_curlyx;
                cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
-                ST.cp = regcppush(rex, ST.save_curlyx->u.curlyx.parenfloor,
-                            maxopenparen);
-               REGCP_SET(ST.lastcp);
                PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B,
                                     locinput);
                NOT_REACHED; /* NOTREACHED */
@@ -7596,11 +7609,11 @@ NULL
            CACHEsayNO;
            NOT_REACHED; /* NOTREACHED */
 
-       case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
-           /* FALLTHROUGH */
        case WHILEM_A_pre_fail: /* just failed to match even minimal A */
            REGCP_UNWIND(ST.lastcp);
             regcppop(rex, &maxopenparen);
+           /* FALLTHROUGH */
+       case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
            cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
            cur_curlyx->u.curlyx.count--;
            CACHEsayNO;
@@ -7633,8 +7646,6 @@ NULL
 
        case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
            cur_curlyx = ST.save_curlyx;
-           REGCP_UNWIND(ST.lastcp);
-            regcppop(rex, &maxopenparen);
 
            if (cur_curlyx->u.curlyx.count >= /*max*/ARG2(cur_curlyx->u.curlyx.me)) {
                /* Maximum greed exceeded */
@@ -7656,9 +7667,6 @@ NULL
            );
            /* Try grabbing another A and see if it helps. */
            cur_curlyx->u.curlyx.lastloc = locinput;
-            ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
-                            maxopenparen);
-           REGCP_SET(ST.lastcp);
            PUSH_STATE_GOTO(WHILEM_A_min,
                /*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS,
                 locinput);
@@ -8263,7 +8271,7 @@ NULL
 
                 SET_RECURSE_LOCINPUT("FAKE-END[after]", cur_eval->locinput);
 
-                PUSH_YES_STATE_GOTO(EVAL_AB, st->u.eval.prev_eval->u.eval.B,
+                PUSH_YES_STATE_GOTO(EVAL_postponed_AB, st->u.eval.prev_eval->u.eval.B,
                                     locinput); /* match B */
            }
 
@@ -8520,16 +8528,17 @@ NULL
            DEBUG_STACK_r({
                regmatch_state *cur = st;
                regmatch_state *curyes = yes_state;
-               int curd = depth;
+               U32 i;
                regmatch_slab *slab = PL_regmatch_slab;
-                for (;curd > -1 && (depth-curd < 3);cur--,curd--) {
+                for (i = 0; i < 3 && i <= depth; cur--,i++) {
                     if (cur < SLAB_FIRST(slab)) {
                        slab = slab->prev;
                        cur = SLAB_LAST(slab);
                     }
-                    Perl_re_exec_indentf( aTHX_ "#%-3d %-10s %s\n",
+                    Perl_re_exec_indentf( aTHX_ "%4s #%-3d %-10s %s\n",
                         depth,
-                        curd, PL_reg_name[cur->resume_state],
+                        i ? "    " : "push",
+                        depth - i, PL_reg_name[cur->resume_state],
                         (curyes == cur) ? "yes" : ""
                     );
                     if (curyes == cur)
@@ -9746,6 +9755,8 @@ S_to_byte_substr(pTHX_ regexp *prog)
     return TRUE;
 }
 
+#ifndef PERL_IN_XSUB_RE
+
 bool
 Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 * strend, const UV cp)
 {
@@ -9801,6 +9812,7 @@ Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 * strend, cons
     return isGCB(cp_gcb_val, next_cp_gcb_val, strbeg, s, TRUE);
 }
 
+#endif