diff options
author | David Mitchell <davem@iabyn.com> | 2014-02-05 17:32:22 +0000 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2014-02-08 13:50:23 +0000 |
commit | b96863b839ade8b79f6216567b6e5be6f881700e (patch) | |
tree | e6f449a4f666d6d6d5eb8af866d0801cb9ea19b1 | |
parent | a6566820c258792b90db16cf731c02777286aba0 (diff) | |
download | perl-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.c | 8 | ||||
-rw-r--r-- | t/re/pat.t | 8 |
2 files changed, 11 insertions, 5 deletions
@@ -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 |