fix 68564: /g failure with zero-width patterns

This is based on a patch by Father Chrysostomos <sprout@cpan.org>

The start class optimisation has two modes, "try every valid start
position" (doevery) and "flip flop mode" (!doevery) where it trys
only the first valid start position in a sequence.

Consider /(\d+)X/ and the string "123456Y", now we know that if we fail
to match X after matching "123456" then we will also fail to match after
"23456" (assuming no evil tricks are in place, which disable the
optimisation anyway), so we know we can skip forward until the check
/fails/ and only then start looking for a real match. This is flip-flop
mode.

Now consider the case with zero-width lookahead under /g: /(?=(\d+)X)/.
In this case we have an additional failure mode, that is failure when
we match a zero-width string twice at the same pos(). So now, the
"flip-flop" logic breaks as it /is/ possible that we could match at
"23456" when we couldn't match at "123456" because of the zero-length
twice at the same pos() rule. For instance:

  print $1 for "123"=~/(?=(\d+))/g

should first match "123". Since $& is zero length, pos() is not
incremented. We then match again, successfully, except that the match
is rejected despite technical-success because its $& is also zero
length and pos() has not advanced. If the flip-flop mode is enabled
we wont retry until we find a failing character first.

The point here is that it makes perfect sense to disable the
"flip-flop" mode optimisation when the start class is inside
a lookahead as it really doesnt apply.

diff --git a/regcomp.c b/regcomp.c
index 74f1aa6..52ba052 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -4347,8 +4347,13 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 pm_flags)
     regnode *scan;
     I32 flags;
     I32 minlen = 0;
+
+    /* these are all flags - maybe they should be turned
+     * into a single int with different bit masks */
+    I32 sawlookahead = 0;
     I32 sawplus = 0;
     I32 sawopen = 0;
+
     U8 jump_ret = 0;
     dJMPENV;
     scan_data_t data;
@@ -4616,7 +4621,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 pm_flags)
     }
 
 reStudy:
-    r->minlen = minlen = sawplus = sawopen = 0;
+    r->minlen = minlen = sawlookahead = sawplus = sawopen = 0;
     Zero(r->substrs, 1, struct reg_substr_data);
 
 #ifdef TRIE_STUDY_OPT
@@ -4664,7 +4669,6 @@ reStudy:
        I32 last_close = 0; /* pointed to by data */
         regnode *first= scan;
         regnode *first_next= regnext(first);
-       
        /*
         * Skip introductions and multiplicators >= 1
         * so that we can extract the 'meat' of the pattern that must 
@@ -4680,7 +4684,7 @@ reStudy:
               /* An OR of *one* alternative - should not happen now. */
            (OP(first) == BRANCH && OP(first_next) != BRANCH) ||
            /* for now we can't handle lookbehind IFMATCH*/
-           (OP(first) == IFMATCH && !first->flags) || 
+           (OP(first) == IFMATCH && !first->flags && (sawlookahead = 1)) ||
            (OP(first) == PLUS) ||
            (OP(first) == MINMOD) ||
               /* An {n,m} with n>0 */
@@ -4767,7 +4771,7 @@ reStudy:
            first = NEXTOPER(first);
            goto again;
        }
-       if (sawplus && (!sawopen || !RExC_sawback)
+       if (sawplus && !sawlookahead && (!sawopen || !RExC_sawback)
            && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
            /* x+ must match at the 1st pos of run of x's */
            r->intflags |= PREGf_SKIP;

diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index e63cd3b..df99d9c 100644 (file)
--- a/t/re/pat_rt_report.t
+++ b/t/re/pat_rt_report.t
@@ -21,7 +21,7 @@ BEGIN {
 }
 
 
-plan tests => 2511;  # Update this when adding/deleting tests.
+plan tests => 2512;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1218,6 +1218,13 @@ sub run_tests {
        iseq($w,undef);
     }
 
+    {
+        local $BugId = 68564;   # minimal CURLYM limited to 32767 matches
+        local $Message = "stclass optimisation does not break + inside (?=)";
+        iseq join("-", "   abc   def  " =~ /(?=(\S+))/g),
+             "abc-bc-c-def-ef-f",
+    }
+
 } # End of sub run_tests
 
 1;