re_intuit_start(): reduce scope of /^...$/m test

Intuit has a quick reject test for a fixed pattern that is anchored at
both ends. For example, with the pattern /^abcd$/, only the exact strings
"abcd" or "abcd\n" will match; anything else, and the match immediately
fails.

A fix for [perl #115242] correctly made intuit skip the test in the
presence of //m, since in this case the $ doesn't necessarily correspond
to the end of the string.

However, the fix was too wide in scope; it caused //m patterns to skip
searching for a known string anchored just at the start, as well as one
anchored at both ends.

With this commit, the following code now runs in a few milliseconds rather
than a few seconds on my machine:

    $s = "abcdefg" x 1_000_000;
    $s =~ /(?-m:^)abcX?fg/m for 1..100;

diff --git a/regexec.c b/regexec.c
index 54400f1..e3ce022 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -783,10 +783,7 @@ Perl_re_intuit_start(pTHX_
              * at position pos()-4+1, which lines up with the "a" */
 
            if (prog->check_offset_min == prog->check_offset_max
-                && !(prog->intflags & PREGf_CANY_SEEN)
-                && ! multiline)   /* /m can cause \n's to match that aren't
-                                     accounted for in the string max length.
-                                     See [perl #115242] */
+                && !(prog->intflags & PREGf_CANY_SEEN))
             {
                /* Substring at constant offset from beg-of-str... */
                SSize_t slen = SvCUR(check);
@@ -798,7 +795,7 @@ Perl_re_intuit_start(pTHX_
                     "  Looking for check substr at fixed offset %"IVdf"...\n",
                     (IV)prog->check_offset_min));
 
-               if (SvTAIL(check)) {
+               if (SvTAIL(check) && !multiline) {
                     /* In this case, the regex is anchored at the end too,
                      * so the lengths must match exactly, give or take a \n.
                     * NB: slen >= 1 since the last char of check is \n */

diff --git a/t/re/pat.t b/t/re/pat.t
index 472141d..ae20155 100644 (file)
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -20,7 +20,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 718;  # Update this when adding/deleting tests.
+plan tests => 719;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1543,6 +1543,10 @@ EOP
         $s =~ /$r\d{1,2}xyz/m for 1..200;
         pass("BOL within //m  mustn't run slowly");
 
+        $s = "abcdefg" x 1_000_000;
+        $s =~ /(?-m:^)abcX?fg/m for 1..100;
+        pass("BOL within //m  mustn't skip absolute anchored check");
+
     }
 
     # These are based on looking at the code in regcomp.c