diff options
author | Yves Orton <demerphq@gmail.com> | 2009-09-09 14:20:10 +0200 |
---|---|---|
committer | Yves Orton <demerphq@gmail.com> | 2009-09-09 14:38:16 +0200 |
commit | c584a96ef5d541fd119f21c2c77f6ffe2b2c0370 (patch) | |
tree | cceb8046d509f8e5c021c228cd0c1e8bf673608a /regexec.c | |
parent | ff611077d15f58be0a6028db917f26718fd19c69 (diff) | |
download | perl-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.c | 5 |
1 files changed, 4 insertions, 1 deletions
@@ -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; } |