Skip to content

Commit

Permalink
Stop minlen regexp optimisation from rejecting long strings
Browse files Browse the repository at this point in the history
This fixes #112790 and part of #116907.

The length of the string is cast to I32, so it wraps and end up less
than the minimum length.

For now, simply skip this optimisation if minlen itself wraps and
becomes negative.
  • Loading branch information
Father Chrysostomos committed Aug 25, 2013
1 parent bf05793 commit 389ecb5
Show file tree
Hide file tree
Showing 3 changed files with 24 additions and 1 deletion.
1 change: 1 addition & 0 deletions MANIFEST
Expand Up @@ -4939,6 +4939,7 @@ t/base/while.t See if while work
t/benchmark/rt26188-speed-up-keys-on-empty-hash.t Benchmark if keys on empty hashes is fast enough
t/bigmem/pos.t Check that pos() handles large offsets
t/bigmem/read.t Check read() handles large offsets
t/bigmem/regexp.t Test regular expressions with large strings
t/bigmem/vec.t Check vec() handles large offsets
t/cmd/elsif.t See if else-if works
t/cmd/for.t See if for loops work
Expand Down
2 changes: 1 addition & 1 deletion pp_hot.c
Expand Up @@ -1383,7 +1383,7 @@ PP(pp_match)
rx = PM_GETRE(pm);
}

if (RX_MINLEN(rx) > (I32)len) {
if (RX_MINLEN(rx) >= 0 && (STRLEN)RX_MINLEN(rx) > len) {
DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match\n"));
goto nope;
}
Expand Down
22 changes: 22 additions & 0 deletions t/bigmem/regexp.t
@@ -0,0 +1,22 @@
#!perl
BEGIN {
chdir 't';
unshift @INC, "../lib";
require './test.pl';
}

use Config qw(%Config);

$ENV{PERL_TEST_MEMORY} >= 2
or skip_all("Need ~2Gb for this test");
$Config{ptrsize} >= 8
or skip_all("Need 64-bit pointers for this test");

plan(2);

# [perl #116907]
# ${\2} to defeat constant folding, which in this case actually slows
# things down
my $x=" "x(${\2}**31);
ok $x =~ /./, 'match against long string succeeded';
is "$-[0]-$+[0]", '0-1', '@-/@+ after match against long string';

0 comments on commit 389ecb5

Please sign in to comment.