diff options
| -rw-r--r-- | lib/diagnostics.pm | 6 | ||||
| -rw-r--r-- | lib/diagnostics.t | 10 |
2 files changed, 11 insertions, 5 deletions
diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index a40da9ea14..78e2c1533b 100644 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -416,7 +416,7 @@ my %msg; # Since we strip "\.\n" when we search a warning, strip it here as well $header =~ s/\.?$//; - my @toks = split( /(%l?[dx]|%u|%c|%(?:\.\d+)?[fs])/, $header ); + my @toks = split( /(%l?[dxX]|%u|%c|%(?:\.\d+)?[fs])/, $header ); if (@toks > 1) { my $conlen = 0; for my $i (0..$#toks){ @@ -429,8 +429,8 @@ my %msg; $toks[$i] = $i == $#toks ? '.*' : '.*?'; } elsif( $toks[$i] =~ '%.(\d+)s' ){ $toks[$i] = ".{$1}"; - } elsif( $toks[$i] =~ '^%l*x$' ){ - $toks[$i] = '[\da-f]+'; + } elsif( $toks[$i] =~ '^%l*([xX])$' ){ + $toks[$i] = $1 eq 'x' ? '[\da-f]+' : '[\dA-F]+'; } } elsif( length( $toks[$i] ) ){ $toks[$i] = quotemeta $toks[$i]; diff --git a/lib/diagnostics.t b/lib/diagnostics.t index 4e5ab8230b..d0d43646ba 100644 --- a/lib/diagnostics.t +++ b/lib/diagnostics.t @@ -5,7 +5,7 @@ BEGIN { @INC = 'lib'; } -use Test::More tests => 10; +use Test::More tests => 11; BEGIN { my $w; @@ -45,7 +45,7 @@ like $warning, qr/using lex_stuff_pvn or similar/, 'L<foo|bar/baz>'; # Multiple messages with the same description seek STDERR, 0,0; $warning = ''; -warn 'Code point 0x%X is not Unicode, may not be portable'; +warn 'Code point 0xBEE5 is not Unicode, may not be portable'; like $warning, qr/W utf8/, 'Message sharing its description with the following message'; @@ -61,6 +61,12 @@ $warning = ''; warn "Bad arg length for us, is 4, should be 42"; like $warning, qr/In C parlance/, '%u works'; +# Test for %X +seek STDERR, 0,0; +$warning = ''; +warn "Unicode surrogate U+C0FFEE is illegal in UTF-8"; +like $warning, qr/You had a UTF-16 surrogate/, '%X'; + # Strip S<> seek STDERR, 0,0; $warning = ''; |