summaryrefslogtreecommitdiff
path: root/regexec.c
diff options
context:
space:
mode:
authorYves Orton <demerphq@gmail.com>2009-09-09 14:20:10 +0200
committerYves Orton <demerphq@gmail.com>2009-09-09 14:38:16 +0200
commitc584a96ef5d541fd119f21c2c77f6ffe2b2c0370 (patch)
treecceb8046d509f8e5c021c228cd0c1e8bf673608a /regexec.c
parentff611077d15f58be0a6028db917f26718fd19c69 (diff)
downloadperl-c584a96ef5d541fd119f21c2c77f6ffe2b2c0370.tar.gz
Fix RT69056 - postive GPOS leads to segv on first match
http://rt.perl.org/rt3/Ticket/Display.html?id=69056 In perl 5.8 we get this: $ perl -Mre=debug -le '$_="foo"; s/(.)\G//g; print' Freeing REx: `","' Compiling REx `(.)\G' size 7 Got 60 bytes for offset annotations. first at 3 1: OPEN1(3) 3: REG_ANY(4) 4: CLOSE1(6) 6: GPOS(7) 7: END(0) GPOS minlen 1 Offsets: [7] 1[1] 0[0] 2[1] 3[1] 0[0] 4[2] 6[0] Matching REx `(.)\G' against `foo' Setting an EVAL scope, savestack=3 0 <> <foo> | 1: OPEN1 0 <> <foo> | 3: REG_ANY 1 <f> <oo> | 4: CLOSE1 1 <f> <oo> | 6: GPOS failed... Setting an EVAL scope, savestack=3 1 <f> <oo> | 1: OPEN1 1 <f> <oo> | 3: REG_ANY 2 <fo> <o> | 4: CLOSE1 2 <fo> <o> | 6: GPOS failed... Setting an EVAL scope, savestack=3 2 <fo> <o> | 1: OPEN1 2 <fo> <o> | 3: REG_ANY 3 <foo> <> | 4: CLOSE1 3 <foo> <> | 6: GPOS failed... Setting an EVAL scope, savestack=3 3 <foo> <> | 1: OPEN1 3 <foo> <> | 3: REG_ANY failed... Match failed foo Freeing REx: `"(.)\\G"' In perl 5.10 we get this: $ perl -Mre=debug -le '$_="foo"; s/(.)\G//g; print' Compiling REx "(.)\G" Final program: 1: OPEN1 (3) 3: REG_ANY (4) 4: CLOSE1 (6) 6: GPOS (7) 7: END (0) anchored(GPOS) GPOS:1 minlen 1 Matching REx "(.)\G" against "foo" -1 <> <%0foo> | 1:OPEN1(3) -1 <> <%0foo> | 3:REG_ANY(4) 0 <> <foo> | 4:CLOSE1(6) 0 <> <foo> | 6:GPOS(7) 0 <> <foo> | 7:END(0) Match successful! Segmentation fault With this patch we get: $ ./perl -Ilib -Mre=debug -le '$_="foo"; s/(.)\G//g; print' Compiling REx "(.)\G" Final program: 1: OPEN1 (3) 3: REG_ANY (4) 4: CLOSE1 (6) 6: GPOS (7) 7: END (0) anchored(GPOS) GPOS:1 minlen 1 Matching REx "(.)\G" against "foo" Match failed foo Freeing REx: "(.)\G" Which seems to me to be a net improvement.
Diffstat (limited to 'regexec.c')
-rw-r--r--regexec.c5
1 files changed, 4 insertions, 1 deletions
diff --git a/regexec.c b/regexec.c
index 5d31d735ff..56dfe121ab 100644
--- a/regexec.c
+++ b/regexec.c
@@ -1833,6 +1833,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
if (s > reginfo.ganch)
goto phooey;
s = reginfo.ganch - prog->gofs;
+ if (s < strbeg)
+ goto phooey;
}
}
else if (data) {
@@ -1915,7 +1917,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN
and we only enter this block when the same bit is set. */
char *tmp_s = reginfo.ganch - prog->gofs;
- if (regtry(&reginfo, &tmp_s))
+
+ if (tmp_s >= strbeg && regtry(&reginfo, &tmp_s))
goto got_it;
goto phooey;
}