Yves Orton
2010-11-02 10:45:25 UTC
In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/d085b4908fc15b9d48cec72b473eec9d0870015b?hp=bc85b3a10e47c5c8502769213905752616fa4a91>
- Log -----------------------------------------------------------------
commit d085b4908fc15b9d48cec72b473eec9d0870015b
Author: Yves Orton <***@gmail.com>
Date: Tue Nov 2 11:29:18 2010 +0100
Fix RT-70998: qq{\x{30ab}} =~ /\xab|\xa9/ produces warnings
M regexec.c
commit aca53033b83659a859fd8408e90d33b842414c39
Author: Father Chrysostomos <***@cpan.org>
Date: Tue Nov 2 11:28:33 2010 +0100
Add test for rt-70998: qq{\x{30ab}} =~ /\xab|\xa9/ produces warnings
M t/re/pat_rt_report.t
commit 441139fca846704946fc96fc56cee06d31d772cc
Author: Yves Orton <***@gmail.com>
Date: Tue Nov 2 10:44:18 2010 +0100
remove commit bit so that porting tests dont fail
-----------------------------------------------------------------------
Summary of changes:
regexec.c | 14 ++++++++++----
t/re/pat_rt_report.t | 39 ++++++++++++++++++++++++++++++++++++++-
2 files changed, 48 insertions(+), 5 deletions(-)
diff --git a/regexec.c b/regexec.c
index 2c9b852..2e15b45 100644
--- a/regexec.c
+++ b/regexec.c
@@ -1780,10 +1780,16 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
PerlIO_printf( Perl_debug_log,
" Scanning for legal start char...\n");
}
- );
- while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
- uc++;
- }
+ );
+ if (utf8_target) {
+ while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
+ uc += UTF8SKIP(uc);
+ }
+ } else {
+ while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
+ uc++;
+ }
+ }
s= (char *)uc;
}
if (uc >(U8*)last_start) break;
diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index 33b6f7c..e63cd3b 100644
--- a/t/re/pat_rt_report.t
+++ b/t/re/pat_rt_report.t
@@ -21,7 +21,7 @@ BEGIN {
}
-plan tests => 2510; # Update this when adding/deleting tests.
+plan tests => 2511; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -1181,6 +1181,43 @@ sub run_tests {
iseq($first, $second);
}
+
+ {
+ local $BugId = 70998;
+ local $Message
+ = 'utf8 =~ /trie/ where trie matches a continuation octet';
+
+ # Catch warnings:
+ my $w;
+ local $SIG{__WARN__} = sub { $w .= shift };
+
+ # This bug can be reduced to
+ qq{\x{30ab}} =~ /\xab|\xa9/;
+ # but it's nice to have a more 'real-world' test. The original test
+ # case from the RT ticket follows:
+
+ my %conv = (
+ "\xab" => "<",
+ "\xa9" => "(c)",
+ );
+ my $conv_rx = '(' . join('|', map { quotemeta } keys %conv) . ')';
+ $conv_rx = qr{$conv_rx};
+
+ my $x
+ = qq{\x{3042}\x{304b}\x{3055}\x{305f}\x{306a}\x{306f}\x{307e}}
+ . qq{\x{3084}\x{3089}\x{308f}\x{3093}\x{3042}\x{304b}\x{3055}}
+ . qq{\x{305f}\x{306a}\x{306f}\x{307e}\x{3084}\x{3089}\x{308f}}
+ . qq{\x{3093}\x{30a2}\x{30ab}\x{30b5}\x{30bf}\x{30ca}\x{30cf}}
+ . qq{\x{30de}\x{30e4}\x{30e9}\x{30ef}\x{30f3}\x{30a2}\x{30ab}}
+ . qq{\x{30b5}\x{30bf}\x{30ca}\x{30cf}\x{30de}\x{30e4}\x{30e9}}
+ . qq{\x{30ef}\x{30f3}\x{30a2}\x{30ab}\x{30b5}\x{30bf}\x{30ca}}
+ . qq{\x{30cf}\x{30de}\x{30e4}\x{30e9}\x{30ef}\x{30f3}};
+
+ $x =~ s{$conv_rx}{$conv{$1}}eg;
+
+ iseq($w,undef);
+ }
+
} # End of sub run_tests
1;
--
Perl5 Master Repository
<http://perl5.git.perl.org/perl.git/commitdiff/d085b4908fc15b9d48cec72b473eec9d0870015b?hp=bc85b3a10e47c5c8502769213905752616fa4a91>
- Log -----------------------------------------------------------------
commit d085b4908fc15b9d48cec72b473eec9d0870015b
Author: Yves Orton <***@gmail.com>
Date: Tue Nov 2 11:29:18 2010 +0100
Fix RT-70998: qq{\x{30ab}} =~ /\xab|\xa9/ produces warnings
M regexec.c
commit aca53033b83659a859fd8408e90d33b842414c39
Author: Father Chrysostomos <***@cpan.org>
Date: Tue Nov 2 11:28:33 2010 +0100
Add test for rt-70998: qq{\x{30ab}} =~ /\xab|\xa9/ produces warnings
M t/re/pat_rt_report.t
commit 441139fca846704946fc96fc56cee06d31d772cc
Author: Yves Orton <***@gmail.com>
Date: Tue Nov 2 10:44:18 2010 +0100
remove commit bit so that porting tests dont fail
-----------------------------------------------------------------------
Summary of changes:
regexec.c | 14 ++++++++++----
t/re/pat_rt_report.t | 39 ++++++++++++++++++++++++++++++++++++++-
2 files changed, 48 insertions(+), 5 deletions(-)
diff --git a/regexec.c b/regexec.c
index 2c9b852..2e15b45 100644
--- a/regexec.c
+++ b/regexec.c
@@ -1780,10 +1780,16 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
PerlIO_printf( Perl_debug_log,
" Scanning for legal start char...\n");
}
- );
- while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
- uc++;
- }
+ );
+ if (utf8_target) {
+ while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
+ uc += UTF8SKIP(uc);
+ }
+ } else {
+ while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
+ uc++;
+ }
+ }
s= (char *)uc;
}
if (uc >(U8*)last_start) break;
diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index 33b6f7c..e63cd3b 100644
--- a/t/re/pat_rt_report.t
+++ b/t/re/pat_rt_report.t
@@ -21,7 +21,7 @@ BEGIN {
}
-plan tests => 2510; # Update this when adding/deleting tests.
+plan tests => 2511; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -1181,6 +1181,43 @@ sub run_tests {
iseq($first, $second);
}
+
+ {
+ local $BugId = 70998;
+ local $Message
+ = 'utf8 =~ /trie/ where trie matches a continuation octet';
+
+ # Catch warnings:
+ my $w;
+ local $SIG{__WARN__} = sub { $w .= shift };
+
+ # This bug can be reduced to
+ qq{\x{30ab}} =~ /\xab|\xa9/;
+ # but it's nice to have a more 'real-world' test. The original test
+ # case from the RT ticket follows:
+
+ my %conv = (
+ "\xab" => "<",
+ "\xa9" => "(c)",
+ );
+ my $conv_rx = '(' . join('|', map { quotemeta } keys %conv) . ')';
+ $conv_rx = qr{$conv_rx};
+
+ my $x
+ = qq{\x{3042}\x{304b}\x{3055}\x{305f}\x{306a}\x{306f}\x{307e}}
+ . qq{\x{3084}\x{3089}\x{308f}\x{3093}\x{3042}\x{304b}\x{3055}}
+ . qq{\x{305f}\x{306a}\x{306f}\x{307e}\x{3084}\x{3089}\x{308f}}
+ . qq{\x{3093}\x{30a2}\x{30ab}\x{30b5}\x{30bf}\x{30ca}\x{30cf}}
+ . qq{\x{30de}\x{30e4}\x{30e9}\x{30ef}\x{30f3}\x{30a2}\x{30ab}}
+ . qq{\x{30b5}\x{30bf}\x{30ca}\x{30cf}\x{30de}\x{30e4}\x{30e9}}
+ . qq{\x{30ef}\x{30f3}\x{30a2}\x{30ab}\x{30b5}\x{30bf}\x{30ca}}
+ . qq{\x{30cf}\x{30de}\x{30e4}\x{30e9}\x{30ef}\x{30f3}};
+
+ $x =~ s{$conv_rx}{$conv{$1}}eg;
+
+ iseq($w,undef);
+ }
+
} # End of sub run_tests
1;
--
Perl5 Master Repository