perl/perl-5.24.1-fix-RT-130561-r...

94 lines
3.5 KiB
Diff

From fbb9dc823a06b4815ee8fd8632fc475b8034e379 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Fri, 27 Jan 2017 10:18:51 +0100
Subject: [PATCH] fix RT #130561 - recursion and optimising away impossible
quantifiers are not friends
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Ported to 5.24.1:
commit 31fc93954d1f379c7a49889d91436ce99818e1f6
Author: Yves Orton <demerphq@gmail.com>
Date: Fri Jan 27 10:18:51 2017 +0100
fix RT #130561 - recursion and optimising away impossible quantifiers are not friends
Instead of optimising away impossible quantifiers like (foo){1,0} treat them
as unquantified, and guard them with an OPFAIL. Thus /(foo){1,0}/ is treated
the same as /(*FAIL)(foo)/ this is important in patterns like /(foo){1,0}|(?1)/
where the (?1) needs to be able to recurse into the (foo) even though the
(foo){1,0} can never match. It also resolves various issues (SEGVs) with patterns
like /((?1)){1,0}/.
This patch would have been easier if S_reginsert() documented that it is
the callers responsibility to properly set up the NEXT_OFF() of the inserted
node (if the node has a NEXT_OFF())
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 14 +++-----------
t/re/pat_rt_report.t | 11 ++++++++++-
2 files changed, 13 insertions(+), 12 deletions(-)
diff --git a/regcomp.c b/regcomp.c
index bcb8db5..9f343d3 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -11497,19 +11497,11 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
nextchar(pRExC_state);
if (max < min) { /* If can't match, warn and optimize to fail
unconditionally */
- if (SIZE_ONLY) {
-
- /* We can't back off the size because we have to reserve
- * enough space for all the things we are about to throw
- * away, but we can shrink it by the amount we are about
- * to re-use here */
- RExC_size += PREVOPER(RExC_size) - regarglen[(U8)OPFAIL];
- }
- else {
+ if (PASS2) {
ckWARNreg(RExC_parse, "Quantifier {n,m} with n > m can't match");
- RExC_emit = orig_emit;
}
- ret = reganode(pRExC_state, OPFAIL, 0);
+ reginsert(pRExC_state, OPFAIL, orig_emit, depth+1);
+ NEXT_OFF(orig_emit)= regarglen[OPFAIL] + NODE_STEP_REGNODE;
return ret;
}
else if (min == max && *RExC_parse == '?')
diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index cb02ad2..2c1dbc4 100644
--- a/t/re/pat_rt_report.t
+++ b/t/re/pat_rt_report.t
@@ -20,7 +20,7 @@ use warnings;
use 5.010;
use Config;
-plan tests => 2500; # Update this when adding/deleting tests.
+plan tests => 2502; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -1113,6 +1113,15 @@ EOP
my $s = "\x{1ff}" . "f" x 32;
ok($s =~ /\x{1ff}[[:alpha:]]+/gca, "POSIXA pointer wrap");
}
+ {
+ # rt
+ fresh_perl_is(
+ '"foo"=~/((?1)){8,0}/; print "ok"',
+ "ok", {}, 'RT #130561 - allowing impossible quantifier should not cause SEGVs');
+ my $s= "foo";
+ ok($s=~/(foo){1,0}|(?1)/,
+ "RT #130561 - allowing impossible quantifier should not break recursion");
+ }
} # End of sub run_tests
1;
--
2.7.4