summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2014-02-05 17:32:22 +0000
committerDavid Mitchell <davem@iabyn.com>2014-02-08 13:50:23 +0000
commitb96863b839ade8b79f6216567b6e5be6f881700e (patch)
treee6f449a4f666d6d6d5eb8af866d0801cb9ea19b1
parenta6566820c258792b90db16cf731c02777286aba0 (diff)
downloadperl-b96863b839ade8b79f6216567b6e5be6f881700e.tar.gz
re_intuit_start(): don't decrease rx_origin
When calculating the new rx_origin after a successful check match, don't set it to a lower value than it already is. This can avoid having to do repeated HOP(check_at, -max_offset) over the same section of string, which makes the following take milliseconds rather than 10's of seconds: $s = "-a-bc" x 250_000; $s .= "1a1bc"; utf8::upgrade($s); $s =~ /\da\d{0,30000}bc/ or die;
-rw-r--r--regexec.c8
-rw-r--r--t/re/pat.t8
2 files changed, 11 insertions, 5 deletions
diff --git a/regexec.c b/regexec.c
index b04c29920f..37253a54f1 100644
--- a/regexec.c
+++ b/regexec.c
@@ -883,12 +883,12 @@ Perl_re_intuit_start(pTHX_
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(check_at - i_strpos)) );
/* set rx_origin to the minimum position where the regex could start
- * matching, given the constraint of the just-matched check substring
+ * matching, given the constraint of the just-matched check substring.
+ * But don't set it lower than previously.
*/
- rx_origin = (check_at - strpos <= prog->check_offset_max)
- ? strpos
- : HOP3c(check_at, -prog->check_offset_max, strpos);
+ if (check_at - rx_origin > prog->check_offset_max)
+ rx_origin = HOP3c(check_at, -prog->check_offset_max, rx_origin);
/* XXX dmq: first branch is for positive lookbehind...
diff --git a/t/re/pat.t b/t/re/pat.t
index 9296808562..486238c804 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -20,7 +20,7 @@ BEGIN {
require './test.pl';
}
-plan tests => 715; # Update this when adding/deleting tests.
+plan tests => 716; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -1528,6 +1528,12 @@ EOP
$s=~ /ab.{1,2}x/;
pass("RT#120692 ab.{1,2} mustn't run slowly");
+
+ $s = "-a-bc" x 250_000;
+ $s .= "1a1bc";
+ utf8::upgrade($s);
+ ok($s =~ /\da\d{0,30000}bc/, "\\d{30000}");
+
}
# These are based on looking at the code in regcomp.c