From: Yves Orton Date: Wed, 9 Sep 2009 12:20:10 +0000 (+0200) Subject: Fix RT69056 - postive GPOS leads to segv on first match X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c584a96ef5d541fd119f21c2c77f6ffe2b2c0370;p=p5sagit%2Fp5-mst-13.2.git 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 <> | 1: OPEN1 0 <> | 3: REG_ANY 1 | 4: CLOSE1 1 | 6: GPOS failed... Setting an EVAL scope, savestack=3 1 | 1: OPEN1 1 | 3: REG_ANY 2 | 4: CLOSE1 2 | 6: GPOS failed... Setting an EVAL scope, savestack=3 2 | 1: OPEN1 2 | 3: REG_ANY 3 <> | 4: CLOSE1 3 <> | 6: GPOS failed... Setting an EVAL scope, savestack=3 3 <> | 1: OPEN1 3 <> | 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 <> | 4:CLOSE1(6) 0 <> | 6:GPOS(7) 0 <> | 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. --- diff --git a/regexec.c b/regexec.c index 5d31d73..56dfe12 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(®info, &tmp_s)) + + if (tmp_s >= strbeg && regtry(®info, &tmp_s)) goto got_it; goto phooey; }