This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH: [perl #122090] Non-word-boundary doesn't match EOS
authorKarl Williamson <khw@cpan.org>
Mon, 23 Jun 2014 01:52:59 +0000 (19:52 -0600)
committerKarl Williamson <khw@cpan.org>
Fri, 27 Jun 2014 00:09:19 +0000 (18:09 -0600)
The root cause of this is that the loop is a "< strend" instead of a
"<=".  However, the macro that is called to form the loop is used
elsewhere where "<" is appropriate.  So I opted to just repeat the
small salient portions of the loop right after it so it gets executed
one final time in the final position.

This code:
 if ((!prog->minlen && tmp) && (reginfo->intuit || regtry(reginfo, &s))) \
           goto got_it;
had the effect previously of causing \b to look at the position just
after the string, but not \B.  By doing it the other way, this is no
longer needed, except I don't understand the prog->minlen portion.  It
isn't used anywhere else in the tests which see if one should goto
got_it, nor do any test suite tests fail by removing it.  I think it is
a relic, but if a bisect should end up blaming this commit, I'd start
with that.

regexec.c
t/re/re_tests
t/re/subst.t

index f71c28a..9d9765e 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -1692,8 +1692,18 @@ REXEC_FBC_SCAN( /* Loops while (s < strend) */                 \
            }                                                                  \
        );                                                                     \
     }                                                                          \
-    if ((!prog->minlen && tmp) && (reginfo->intuit || regtry(reginfo, &s)))    \
-       goto got_it;
+    /* Here, things have been set up by the previous code so that tmp is the   \
+     * return of TEST_NON_UTF(s-1) or TEST_UTF8(s-1) (depending on the         \
+     * utf8ness of the target).  We also have to check if this matches against \
+     * the EOS, which we treat as a \n (which is the same value in both UTF-8  \
+     * or non-UTF8, so can use the non-utf8 test condition even for a UTF-8    \
+     * string */                                                               \
+    if (tmp == ! TEST_NON_UTF8('\n')) {                                        \
+        IF_SUCCESS;                                                            \
+    }                                                                          \
+    else {                                                                     \
+        IF_FAIL;                                                               \
+    }
 
 
 /* We know what class REx starts with.  Try to find this position... */
index 57b5836..964360d 100644 (file)
@@ -134,6 +134,7 @@ a[^]b]c     adc     y       $&      adc
 \By\b  xy      y       -       -
 \by\B  yz      y       -       -
 \By\B  xyz     y       -       -
+\B             y       -       -
 \w     a       y       -       -
 \w     -       n       -       -
 \W     a       n       -       -
index 244bcad..7a15efa 100644 (file)
@@ -5,9 +5,10 @@ BEGIN {
     @INC = '../lib';
     require Config; import Config;
     require './test.pl';
+    require './charset_tools.pl';
 }
 
-plan( tests => 236 );
+plan( tests => 260 );
 
 $_ = 'david';
 $a = s/david/rules/r;
@@ -1002,3 +1003,47 @@ like $@, qr/^Modification of a read-only value/,
 eval { for (__PACKAGE__) { s/b/c/; } };
 like $@, qr/^Modification of a read-only value/,
     'read-only COW =~ s/does not match// should croak';
+
+SKIP: {
+    my $a_acute = chr utf8::unicode_to_native(0xE1); # LATIN SMALL LETTER A WITH ACUTE
+    my $egrave = chr utf8::unicode_to_native(0xE8);  # LATIN SMALL LETTER E WITH GRAVE
+    my $u_umlaut = chr utf8::unicode_to_native(0xFC);  # LATIN SMALL LETTER U WITH DIAERESIS
+    my $division = chr utf8::unicode_to_native(0xF7);  # DIVISION SIGN
+
+    is("ab.c" =~ s/\b/!/agr, "!ab!.!c!", '\\b matches ASCII before string, mid, and end, /a');
+    is("$a_acute$egrave.$u_umlaut" =~ s/\b/!/agr, "$a_acute$egrave.$u_umlaut", '\\b matches Latin1 before string, mid, and end, /a');
+    is("\x{100}\x{101}.\x{102}" =~ s/\b/!/agr, "\x{100}\x{101}.\x{102}", '\\b matches above-Latin1 before string, mid, and end, /a');
+
+    is("..." =~ s/\B/!/agr, "!.!.!.!", '\\B matches ASCII before string, mid, and end, /a');
+    is("$division$division$division" =~ s/\B/!/agr, "!$division!$division!$division!", '\\B matches Latin1 before string, mid, and end, /a');
+    is("\x{2028}\x{2028}\x{2028}" =~ s/\B/!/agr, "!\x{2028}!\x{2028}!\x{2028}!", '\\B matches above-Latin1 before string, mid, and end, /a');
+
+    is("ab.c" =~ s/\b/!/dgr, "!ab!.!c!", '\\b matches ASCII before string, mid, and end, /d');
+    { is("$a_acute$egrave.$u_umlaut" =~ s/\b/!/dgr, "$a_acute$egrave.$u_umlaut", '\\b matches Latin1 before string, mid, and end, /d'); }
+    is("\x{100}\x{101}.\x{102}" =~ s/\b/!/dgr, "!\x{100}\x{101}!.!\x{102}!", '\\b matches above-Latin1 before string, mid, and end, /d');
+
+    is("..." =~ s/\B/!/dgr, "!.!.!.!", '\\B matches ASCII before string, mid, and end, /d');
+    is("$division$division$division" =~ s/\B/!/dgr, "!$division!$division!$division!", '\\B matches Latin1 before string, mid, and end, /d');
+    is("\x{2028}\x{2028}\x{2028}" =~ s/\B/!/dgr, "!\x{2028}!\x{2028}!\x{2028}!", '\\B matches above-Latin1 before string, mid, and end, /d');
+
+    is("ab.c" =~ s/\b/!/ugr, "!ab!.!c!", '\\b matches ASCII before string, mid, and end, /u');
+    is("$a_acute$egrave.$u_umlaut" =~ s/\b/!/ugr, "!$a_acute$egrave!.!$u_umlaut!", '\\b matches Latin1 before string, mid, and end, /u');
+    is("\x{100}\x{101}.\x{102}" =~ s/\b/!/ugr, "!\x{100}\x{101}!.!\x{102}!", '\\b matches above-Latin1 before string, mid, and end, /u');
+
+    is("..." =~ s/\B/!/ugr, "!.!.!.!", '\\B matches ASCII before string, mid, and end, /u');
+    is("$division$division$division" =~ s/\B/!/ugr, "!$division!$division!$division!", '\\B matches Latin1 before string, mid, and end, /u');
+    is("\x{2028}\x{2028}\x{2028}" =~ s/\B/!/ugr, "!\x{2028}!\x{2028}!\x{2028}!", '\\B matches above-Latin1 before string, mid, and end, /u');
+
+    eval { require POSIX; POSIX->import("locale_h") };
+    skip "Can't test locale", 6 unless $@;
+
+    POSIX::setlocale(&POSIX::LC_ALL, "C");
+    use locale;
+    is("a.b" =~ s/\b/!/gr, "!a!.!b!", '\\b matches ASCII before string, mid, and end, /l');
+    is("$a_acute.$egrave" =~ s/\b/!/gr, "$a_acute.$egrave", '\\b matches Latin1 before string, mid, and end, /l');
+    is("\x{100}\x{101}.\x{102}" =~ s/\b/!/gr, "!\x{100}\x{101}!.!\x{102}!", '\\b matches above-Latin1 before string, mid, and end, /l');
+
+    is("..." =~ s/\B/!/gr, "!.!.!.!", '\\B matches ASCII before string, mid, and end, /l');
+    is("$division$division$division" =~ s/\B/!/gr, "!$division!$division!$division!", '\\B matches Latin1 before string, mid, and end, /l');
+    is("\x{2028}\x{2028}\x{2028}" =~ s/\B/!/gr, "!\x{2028}!\x{2028}!\x{2028}!", '\\B matches above-Latin1 before string, mid, and end, /l');
+}