This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix 114884 positive GPOS lookbehind regex substitution failure
[perl5.git] / pp_hot.c
index 4d7467d..bf4aca7 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1320,11 +1320,11 @@ PP(pp_match)
     dVAR; dSP; dTARG;
     PMOP *pm = cPMOP;
     PMOP *dynpm = pm;
-    const char *t;
     const char *s;
     const char *strend;
+    I32 curpos = 0; /* initial pos() or current $+[0] */
     I32 global;
-    U8 r_flags = REXEC_CHECKED;
+    U8 r_flags = 0;
     const char *truebase;                      /* Start of string  */
     REGEXP *rx = PM_GETRE(pm);
     bool rxtainted;
@@ -1334,7 +1334,6 @@ PP(pp_match)
     const I32 oldsave = PL_savestack_ix;
     I32 update_minmatch = 1;
     I32 had_zerolen = 0;
-    U32 gpos = 0;
 
     if (PL_op->op_flags & OPf_STACKED)
        TARG = POPs;
@@ -1348,12 +1347,12 @@ PP(pp_match)
     PUTBACK;                           /* EVAL blocks need stack_sp. */
     /* Skip get-magic if this is a qr// clone, because regcomp has
        already done it. */
-    s = ReANY(rx)->mother_re
+    truebase = ReANY(rx)->mother_re
         ? SvPV_nomg_const(TARG, len)
         : SvPV_const(TARG, len);
-    if (!s)
+    if (!truebase)
        DIE(aTHX_ "panic: pp_match");
-    strend = s + len;
+    strend = truebase + len;
     rxtainted = (RX_ISTAINTED(rx) ||
                 (TAINT_get && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
@@ -1386,22 +1385,17 @@ PP(pp_match)
        goto nope;
     }
 
-    truebase = t = s;
-
     /* XXXX What part of this is needed with true \G-support? */
     if (global) {
        MAGIC * const mg = mg_find_mglob(TARG);
-       RX_OFFS(rx)[0].start = -1;
        if (mg && mg->mg_len >= 0) {
                if (!(RX_EXTFLAGS(rx) & RXf_GPOS_SEEN))
-                   RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
+                   curpos = mg->mg_len;
                else if (RX_EXTFLAGS(rx) & RXf_ANCH_GPOS) {
-                   r_flags |= REXEC_IGNOREPOS;
-                   RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
-               } else if (RX_EXTFLAGS(rx) & RXf_GPOS_FLOAT) 
-                   gpos = mg->mg_len;
-               else 
-                   RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
+                   curpos = mg->mg_len;
+               }
+               else if (!(RX_EXTFLAGS(rx) & RXf_GPOS_FLOAT))
+                   curpos = mg->mg_len;
                minmatch = (mg->mg_flags & MGf_MINMATCH) ? RX_GOFS(rx) + 1 : 0;
                update_minmatch = 0;
        }
@@ -1422,9 +1416,11 @@ PP(pp_match)
             r_flags |= REXEC_COPY_SKIP_POST;
     };
 
+    s = truebase;
+
   play_it_again:
-    if (global && RX_OFFS(rx)[0].start != -1) {
-       t = s = RX_OFFS(rx)[0].end + truebase - RX_GOFS(rx);
+    if (global) {
+       s = truebase + curpos - RX_GOFS(rx);
        if ((s + RX_MINLEN(rx)) > strend || s < truebase) {
            DEBUG_r(PerlIO_printf(Perl_debug_log, "Regex match can't succeed, so not even tried\n"));
            goto nope;
@@ -1432,41 +1428,11 @@ PP(pp_match)
        if (update_minmatch++)
            minmatch = had_zerolen;
     }
-    if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT &&
-       DO_UTF8(TARG) == (RX_UTF8(rx) != 0)) {
-       s = CALLREG_INTUIT_START(rx, TARG, truebase,
-                        (char *)s, (char *)strend, r_flags, NULL);
 
-       if (!s)
-           goto nope;
-       if (RX_EXTFLAGS(rx) & RXf_CHECK_ALL) {
-            /* we can match based purely on the result of INTUIT.
-             * Fix up all the things that won't get set because we skip
-             * calling regexec() */
-            assert(!RX_NPARENS(rx));
-            /* match via INTUIT shouldn't have any captures.
-             * Let @-, @+, $^N know */
-            RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0;
-            RX_MATCH_UTF8_set(rx, cBOOL(DO_UTF8(rx)));
-            if ( !(r_flags & REXEC_NOT_FIRST) )
-                Perl_reg_set_capture_string(aTHX_ rx,
-                                        (char*)truebase, (char *)strend,
-                                        TARG, r_flags, cBOOL(DO_UTF8(TARG)));
-
-            /* skipping regexec means that indices for $&, $-[0] etc not set */
-            RX_OFFS(rx)[0].start = s - truebase;
-            RX_OFFS(rx)[0].end =
-                RX_MATCH_UTF8(rx)
-                    ? (char*)utf8_hop((U8*)s, RX_MINLENRET(rx)) - truebase
-                    : s - truebase + RX_MINLENRET(rx);
-           goto gotcha;
-        }
-    }
     if (!CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase,
-                    minmatch, TARG, NUM2PTR(void*, gpos), r_flags))
+                    minmatch, TARG, NULL, r_flags))
        goto nope;
 
-  gotcha:
     PL_curpm = pm;
     if (dynpm->op_pmflags & PMf_ONCE) {
 #ifdef USE_ITHREADS
@@ -1514,7 +1480,7 @@ PP(pp_match)
            PUSHs(sv_newmortal());
            if ((RX_OFFS(rx)[i].start != -1) && RX_OFFS(rx)[i].end != -1 ) {
                const I32 len = RX_OFFS(rx)[i].end - RX_OFFS(rx)[i].start;
-               s = RX_OFFS(rx)[i].start + truebase;
+               const char * const s = RX_OFFS(rx)[i].start + truebase;
                if (RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0 ||
                    len < 0 || len > strend - s)
                    DIE(aTHX_ "panic: pp_match start/end pointers, i=%ld, "
@@ -1527,9 +1493,11 @@ PP(pp_match)
            }
        }
        if (global) {
+            assert(RX_OFFS(rx)[0].start != -1);
+            curpos = (UV)RX_OFFS(rx)[0].end;
            had_zerolen = (RX_OFFS(rx)[0].start != -1
                           && (RX_OFFS(rx)[0].start + RX_GOFS(rx)
-                              == (UV)RX_OFFS(rx)[0].end));
+                              == (UV)curpos));
            PUTBACK;                    /* EVAL blocks may use stack */
            r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
            goto play_it_again;
@@ -2162,28 +2130,15 @@ PP(pp_subst)
 #endif
 
     orig = m = s;
-    if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) {
-       s = CALLREG_INTUIT_START(rx, TARG, orig, s, strend, r_flags, NULL);
-
-       if (!s)
-           goto ret_no;
-       /* How to do it in subst? */
-/*     if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
-            && !PL_sawampersand
-            && !(RX_EXTFLAGS(rx) & RXf_KEEPCOPY))
-           goto yup;
-*/
-    }
 
-    if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
-                        r_flags | REXEC_CHECKED))
+    if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, r_flags))
     {
-      ret_no:
        SPAGAIN;
        PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_no);
        LEAVE_SCOPE(oldsave);
        RETURN;
     }
+    s = RX_OFFS(rx)[0].start + orig;
 
     PL_curpm = pm;