Fix bug #109206: ANCH_MBOL with while /.*/g
authorYves Orton <demerphq@gmail.com>
Sat, 28 Jan 2012 23:06:23 +0000 (00:06 +0100)
committerYves Orton <demerphq@gmail.com>
Sat, 28 Jan 2012 23:06:23 +0000 (00:06 +0100)
We had a fencepost error when ANCH_MBOL was enabled that meant we
did not "see" matches at the end of string. This fixes the problem
and adds tests.

regexec.c
t/re/pat.t

index 6bd8b20..b84dcbd 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -2245,8 +2245,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
                     /*XXX: The s-- is almost definitely wrong here under unicode - demeprhq*/
                    s--;
                }
-                /* We can use a more efficient search as newlines are the same in unicode as they are in latin */
-               while (s < end) {
+               /* We can use a more efficient search as newlines are the same in unicode as they are in latin */
+               while (s <= end) { /* note it could be possible to match at the end of the string */
                    if (*s++ == '\n') { /* don't need PL_utf8skip here */
                        if (regtry(&reginfo, &s))
                            goto got_it;
index 8ea531c..b4b7ac4 100644 (file)
@@ -21,7 +21,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 466;  # Update this when adding/deleting tests.
+plan tests => 469;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1241,6 +1241,18 @@ EOP
        is "@refs", "Regexp", '/$o$qr/ passes qr ref to cat overload meth';
     }
 
+    {
+        my $count=0;
+        my $str="\n";
+        $count++ while $str=~/.*/g;
+        is $count, 2, 'test that ANCH_MBOL works properly. We should get 2 from $count++ while "\n"=~/.*/g';
+        my $class_count= 0;
+        $class_count++ while $str=~/[^\n]*/g;
+        is $class_count, $count, 'while "\n"=~/.*/g and while "\n"=~/[^\n]*/g should behave the same';
+        my $anch_count= 0;
+        $anch_count++ while $str=~/^.*/mg;
+        is $anch_count, 1, 'while "\n"=~/^.*/mg should match only once';
+    }
 } # End of sub run_tests
 
 1;