This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix rt75680 - when working with utf8 strings one must always use s+=UTF8SKIP(s) to...
authorYves Orton <demerphq@gmail.com>
Mon, 23 Aug 2010 12:36:37 +0000 (14:36 +0200)
committerYves Orton <demerphq@gmail.com>
Mon, 23 Aug 2010 12:42:20 +0000 (14:42 +0200)
Most of the regex code where do the two types of increments are wrapped up in macros.

Unfortunately these macros arent suitable in this case because we use goto to jump
inside the loop under some situations, and since this is a one-off case I figured the
modest C&P associated was better than creating a new macro just for this case.

There is still a possible bug here marked by an XXX, which will need to be fixed
once I find out the correct way to simulate strptr--. Additionally I havent found
a test case that actually exposes this form of the bug.

Moral of the story, utf8 makes string scanning awkward... And slow...

regexec.c
t/re/pat.t

index dd4ec41..35ef8d4 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -2018,33 +2018,68 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
            end = HOP3c(strend, -dontbother, strbeg) - 1;
            /* for multiline we only have to try after newlines */
            if (prog->check_substr || prog->check_utf8) {
-               if (s == startpos)
-                   goto after_try;
-               while (1) {
-                   if (regtry(&reginfo, &s))
-                       goto got_it;
-                 after_try:
-                   if (s > end)
-                       goto phooey;
-                   if (prog->extflags & RXf_USE_INTUIT) {
-                       s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL);
-                       if (!s)
-                           goto phooey;
-                   }
-                   else
-                       s++;
-               }               
-           } else {
-               if (s > startpos)
+                /* because of the goto we can not easily reuse the macros for bifurcating the
+                   unicode/non-unicode match modes here like we do elsewhere - demerphq */
+                if (utf8_target) {
+                    if (s == startpos)
+                        goto after_try_utf8;
+                    while (1) {
+                        if (regtry(&reginfo, &s)) {
+                            goto got_it;
+                        }
+                      after_try_utf8:
+                        if (s > end) {
+                            goto phooey;
+                        }
+                        if (prog->extflags & RXf_USE_INTUIT) {
+                            s = re_intuit_start(rx, sv, s + UTF8SKIP(s), strend, flags, NULL);
+                            if (!s) {
+                                goto phooey;
+                            }
+                        }
+                        else {
+                            s += UTF8SKIP(s);
+                        }
+                    }
+                } /* end search for check string in unicode */
+                else {
+                    if (s == startpos) {
+                        goto after_try_latin;
+                    }
+                    while (1) {
+                        if (regtry(&reginfo, &s)) {
+                            goto got_it;
+                        }
+                      after_try_latin:
+                        if (s > end) {
+                            goto phooey;
+                        }
+                        if (prog->extflags & RXf_USE_INTUIT) {
+                            s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL);
+                            if (!s) {
+                                goto phooey;
+                            }
+                        }
+                        else {
+                            s++;
+                        }
+                    }
+                } /* end search for check string in latin*/
+           } /* end search for check string */
+           else { /* search for newline */
+               if (s > startpos) {
+                    /*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) {
                    if (*s++ == '\n') { /* don't need PL_utf8skip here */
                        if (regtry(&reginfo, &s))
                            goto got_it;
                    }
-               }               
-           }
-       }
+               }
+           } /* end search for newline */
+       } /* end anchored/multiline check string search */
        goto phooey;
     } else if (RXf_GPOS_CHECK == (prog->extflags & RXf_GPOS_CHECK)) 
     {
index d7cf718..8220bae 100644 (file)
@@ -23,7 +23,7 @@ BEGIN {
 }
 
 
-plan tests => 350;  # Update this when adding/deleting tests.
+plan tests => 360;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1003,7 +1003,27 @@ sub run_tests {
             ok $str=~/.*\z/, "implict MBOL check string disable does not break things length=$i";
         }
     }
-
+    {
+        # we are actually testing that we dont die when executing these patterns
+        use utf8;
+        my $e = "Böck";
+        ok(utf8::is_utf8($e),"got a unicode string - rt75680");
+
+        ok($e !~ m/.*?[x]$/, "unicode string against /.*?[x]\$/ - rt75680");
+        ok($e !~ m/.*?\p{Space}$/i, "unicode string against /.*?\\p{space}\$/i - rt75680");
+        ok($e !~ m/.*?[xyz]$/, "unicode string against /.*?[xyz]\$/ - rt75680");
+        ok($e !~ m/(.*?)[,\p{isSpace}]+((?:\p{isAlpha}[\p{isSpace}\.]{1,2})+)\p{isSpace}*$/, "unicode string against big pattern - rt75680");
+    }
+    {
+        # we are actually testing that we dont die when executing these patterns
+        my $e = "B\x{f6}ck";
+        ok(!utf8::is_utf8($e), "got a latin string - rt75680");
+
+        ok($e !~ m/.*?[x]$/, "latin string against /.*?[x]\$/ - rt75680");
+        ok($e !~ m/.*?\p{Space}$/i, "latin string against /.*?\\p{space}\$/i - rt75680");
+        ok($e !~ m/.*?[xyz]$/,"latin string against /.*?[xyz]\$/ - rt75680");
+        ok($e !~ m/(.*?)[,\p{isSpace}]+((?:\p{isAlpha}[\p{isSpace}\.]{1,2})+)\p{isSpace}*$/,"latin string against big pattern - rt75680");
+    }
 } # End of sub run_tests
 
 1;