regexec(): fix ganch and till settings
authorDavid Mitchell <davem@iabyn.com>
Sat, 13 Jul 2013 20:18:50 +0000 (21:18 +0100)
committerDavid Mitchell <davem@iabyn.com>
Sun, 28 Jul 2013 09:33:38 +0000 (10:33 +0100)
Since startpos is now the \G-adjusted start position, use the real start
position instead (stringarg) when setting reginfo->till, and when setting
ganch in the non-pos case.

This stops this infinitely looping:

    $_ = "x"; pos = 1; @a = /x\G/g

regexec.c
t/re/pat.t

index 6b6e7c9..48b21e7 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -2329,7 +2329,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
     reginfo->poscache_maxiter = 0; /* not yet started a countdown */
     reginfo->strend = strend;
     /* see how far we have to get to not match where we matched before */
-    reginfo->till = startpos + minend;
+    reginfo->till = stringarg + minend;
 
     if (prog->extflags & RXf_EVAL_SEEN && SvPADTMP(sv) && !IS_PADGV(sv)) {
         /* SAVEFREESV, not sv_mortalcopy, as this SV must last until after
@@ -2398,9 +2398,9 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
     if (prog->extflags & RXf_GPOS_SEEN) { /* Need to set reginfo->ganch */
        MAGIC *mg;
        if (flags & REXEC_IGNOREPOS){   /* Means: check only at start */
-           reginfo->ganch = startpos + prog->gofs;
+           reginfo->ganch = stringarg;
            DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
-             "GPOS IGNOREPOS: reginfo->ganch = startpos + %"UVxf"\n",(UV)prog->gofs));
+             "GPOS IGNOREPOS: reginfo->ganch = stringarg\n"));
        } else if (sv && (mg = mg_find_mglob(sv))
                  && mg->mg_len >= 0) {
            reginfo->ganch = strbeg + mg->mg_len;       /* Defined pos() */
index 897c3d3..a892490 100644 (file)
@@ -20,7 +20,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 688;  # Update this when adding/deleting tests.
+plan tests => 689;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -750,6 +750,14 @@ sub run_tests {
     }
 
     {
+        my $s = '123';
+        pos($s) = 1;
+        my @a = $s =~ /(\d)\G/g; # this infinitely looped up till 5.19.1
+        is("@a", "1", '\G looping');
+    }
+
+
+    {
         my $message = 'pos inside (?{ })';
         my $str = 'abcde';
         our ($foo, $bar);