re_intuit_start(): use better limit on anch float

The 'check' block of code has special handling for if the pattern is
anchored; in this case, it allows us to set an upper bound on where a
floating substring might match; e.g. in

    /^..\d?abc/

the floating string can't be more than 3 chars from the absolute beginning
of the string. Similarly with /..\G\d?abc/, it can't be more than 3 chars
from the start position (assuming that position been calculated correctly
by the caller).

However, the current code used rx_origin as the base for the offset
calculation, rather than strbeg/strpos as appropriate. This meant that

a) the first time round the loop, if strpos > strbeg, then the upper bound
would be set higher than needed;
b) if we ever go back to restart: with an incremented rx_origin, then the
upper limit is recalculated with more wasted slack at the latter end.

This commit changes the limit calculation, which reduces the following
from second to milliseconds:

    $s = "abcdefg" x 1_000_000;
    $s =~ /^XX\d{1,10}cde/ for 1..100;

It also adds a quick test to skip hopping when the result is likely to
leave end_point unchanged, and adds an explicit test for !PREGf_IMPLICIT.
This latter test isn't strictly necessary, as if PREGf_IMPLICIT were set,
it implies that the pattern starts with '.*', which implies that
prog->check_offset_max == SSize_t_MAX, which is already tested for.
However, it makes the overall condition more comprehensible, and makes it
more robust in the face of future changes.

diff --git a/regexec.c b/regexec.c
index b7ca27b..85a00e9 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -906,19 +906,33 @@ Perl_re_intuit_start(pTHX_
        }
 
 
-        /* if the regex is absolutely anchored to the start of the string,
-         * then check_offset_max represents an upper bound on the string
-         * where the substr could start */
+        /* If the regex is absolutely anchored to either the start of the
+         * string (BOL,SBOL) or to pos() (ANCH_GPOS), then
+         * check_offset_max represents an upper bound on the string where
+         * the substr could start. For the ANCH_GPOS case, we assume that
+         * the caller of intuit will have already set strpos to
+         * pos()-gofs, so in this case strpos + offset_max will still be
+         * an upper bound on the substr.
+         */
         if (!ml_anch
             && prog->intflags & PREGf_ANCH
-            && prog->check_offset_max != SSize_t_MAX
-            && start_shift < prog->check_offset_max)
+            && !(prog->intflags & PREGf_IMPLICIT)
+            && prog->check_offset_max != SSize_t_MAX)
         {
             SSize_t len = SvCUR(check) - !!SvTAIL(check);
-            end_point = HOP3lim(start_point,
-                            prog->check_offset_max - start_shift,
-                            end_point -len)
-                        + len;
+            const char * const anchor =
+                        (prog->intflags & PREGf_ANCH_GPOS ? strpos : strbeg);
+
+            /* do a bytes rather than chars comparison. It's conservative;
+             * so it skips doing the HOP if the result can't possibly end
+             * up earlier than the old value of end_point.
+             */
+            if ((char*)end_point - anchor > prog->check_offset_max) {
+                end_point = HOP3lim((U8*)anchor,
+                                prog->check_offset_max,
+                                end_point -len)
+                            + len;
+            }
         }
 
        DEBUG_OPTIMISE_MORE_r({

diff --git a/t/re/pat.t b/t/re/pat.t
index ae20155..04f8b84 100644 (file)
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -20,7 +20,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 719;  # Update this when adding/deleting tests.
+plan tests => 721;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -755,6 +755,8 @@ sub run_tests {
        ok($_ =~ /^abc\Gdef$/, $message);
        pos = 3;
        ok($_ =~ /c\Gd/, $message);
+       pos = 3;
+       ok($_ =~ /..\GX?def/, $message);
     }
 
     {
@@ -1547,6 +1549,10 @@ EOP
         $s =~ /(?-m:^)abcX?fg/m for 1..100;
         pass("BOL within //m  mustn't skip absolute anchored check");
 
+        $s = "abcdefg" x 1_000_000;
+        $s =~ /^XX\d{1,10}cde/ for 1..100;
+        pass("abs anchored float string should fail quickly");
+
     }
 
     # These are based on looking at the code in regcomp.c