From: Yves Orton <demerphq@gmail.com>
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 <> <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.
---

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(&reginfo, &tmp_s))
+
+	if (tmp_s >= strbeg && regtry(&reginfo, &tmp_s))
 	    goto got_it;
 	goto phooey;
     }