fix intuit_start() with \G
authorDavid Mitchell <davem@iabyn.com>
Fri, 19 Jul 2013 01:08:56 +0000 (02:08 +0100)
committerDavid Mitchell <davem@iabyn.com>
Sun, 28 Jul 2013 09:33:37 +0000 (10:33 +0100)
Intuit assumed that any anchor, including \G, anchored at BOS or after \n.
This obviously isn't the case for \G, so exclude RXf_ANCH_GPOS from the
RXf_ANCH branch.

This has never been spotted before, since intuit used to be skipped when
\G was present.

regexec.c
t/re/pat.t

index 94dc3ce..43d66c9 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -557,13 +557,9 @@ Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, char *strend,
  * with giant delta may be not rechecked).
  */
 
-/* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
-
 /* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
    Otherwise, only SvCUR(sv) is used to get strbeg. */
 
-/* XXXX We assume that strpos is strbeg unless sv. */
-
 /* XXXX Some places assume that there is a fixed substring.
        An update may be needed if optimizer marks as "INTUITable"
        RExen without fixed substrings.  Similarly, it is assumed that
@@ -671,14 +667,15 @@ Perl_re_intuit_start(pTHX_
         }
        check = prog->check_substr;
     }
-    if (prog->extflags & RXf_ANCH) {   /* Match at beg-of-str or after \n */
-       ml_anch = !( (prog->extflags & RXf_ANCH_SINGLE)
+    if ((prog->extflags & RXf_ANCH)    /* Match at beg-of-str or after \n */
+        && !(prog->extflags & RXf_ANCH_GPOS)) /* \G isn't a BOS or \n */
+    {
+        ml_anch = !( (prog->extflags & RXf_ANCH_SINGLE)
                     || ( (prog->extflags & RXf_ANCH_BOL)
                          && !multiline ) );    /* Check after \n? */
 
        if (!ml_anch) {
-         if ( !(prog->extflags & RXf_ANCH_GPOS) /* Checked by the caller */
-               && !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
+         if (    !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
               && (strpos != strbeg)) {
              DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
              goto fail;
index 2071666..897c3d3 100644 (file)
@@ -20,7 +20,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 681;  # Update this when adding/deleting tests.
+plan tests => 688;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -727,6 +727,26 @@ sub run_tests {
         unlike($str, qr/^...\G/, $message);
         ok($str =~ /\G../ && $& eq 'cd', $message);
         ok($str =~ /.\G./ && $& eq 'bc', $message);
+
+    }
+
+    {
+        my $message = '\G and intuit and anchoring';
+       $_ = "abcdef";
+       pos = 0;
+       ok($_ =~ /\Gabc/, $message);
+       ok($_ =~ /^\Gabc/, $message);
+
+       pos = 3;
+       ok($_ =~ /\Gdef/, $message);
+       pos = 3;
+       ok($_ =~ /\Gdef$/, $message);
+       pos = 3;
+       ok($_ =~ /abc\Gdef$/, $message);
+       pos = 3;
+       ok($_ =~ /^abc\Gdef$/, $message);
+       pos = 3;
+       ok($_ =~ /c\Gd/, $message);
     }
 
     {