In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/008e8e82d7383361068156624879df7566121878?hp=2b79cfef7518ea0ccd16f1b34ef8dd2b25877f35>
- Log ----------------------------------------------------------------- commit 008e8e82d7383361068156624879df7566121878 Author: Karl Williamson <[email protected]> Date: Fri Mar 27 22:18:01 2015 -0600 Don't raise Wide char warning in UTF-8 locale This belongs in the category of "I can't believe I did that." Commit 613abc6d16e99bd9834fe6afd79beb61a3a4734d introduced warning messages when a multi-byte character is operated on in a single byte locale. But the two macros introduced fail to suppress said messages when in a multi-byte locale where the operation is perfectly valid. This partially solves v5.22 blocker [perl #123527]. But it could still fail if the test files are called from within a non-UTF-8 locale. I will issue a pull request for fixing that. ----------------------------------------------------------------------- Summary of changes: perl.h | 11 ++++++++--- t/lib/warnings/regexec | 23 +++++++++++++++++++++++ t/lib/warnings/utf8 | 25 +++++++++++++++++++++++++ 3 files changed, 56 insertions(+), 3 deletions(-) diff --git a/perl.h b/perl.h index 50eca37..dceae8f 100644 --- a/perl.h +++ b/perl.h @@ -5826,12 +5826,17 @@ typedef struct am_table_short AMTS; * argument; the 2nd, is a pointer to the first byte of the UTF-8 encoded * string, and an end position which it won't try to read past */ # define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(cp) \ - Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), \ - "Wide character (U+%"UVXf") in %s", (UV) cp, OP_DESC(PL_op)); + STMT_START { \ + if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \ + Perl_warner(aTHX_ packWARN(WARN_LOCALE), \ + "Wide character (U+%"UVXf") in %s", \ + (UV) cp, OP_DESC(PL_op)); \ + } \ + } STMT_END # define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) \ STMT_START { /* Check if to warn before doing the conversion work */\ - if (ckWARN(WARN_LOCALE)) { \ + if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \ UV cp = utf8_to_uvchr_buf((U8 *) s, (U8 *) send, NULL); \ Perl_warner(aTHX_ packWARN(WARN_LOCALE), \ "Wide character (U+%"UVXf") in %s", \ diff --git a/t/lib/warnings/regexec b/t/lib/warnings/regexec index b62ff6e..750880e 100644 --- a/t/lib/warnings/regexec +++ b/t/lib/warnings/regexec @@ -148,6 +148,29 @@ Wide character (U+100) in pattern match (m//) at - line 15. Wide character (U+100) in pattern match (m//) at - line 16. Wide character (U+100) in pattern match (m//) at - line 16. ######## +# NAME Wide character in UTF-8 locale +require '../loc_tools.pl'; +unless (locales_enabled()) { + print("SKIPPED\n# locales not available\n"),exit; +} +eval { require POSIX; POSIX->import("locale_h") }; +if ($@) { + print("SKIPPED\n# no POSIX\n"),exit; +} +my @utf8_locales = find_utf8_ctype_locale(); +unless (@utf8_locales) { + print("SKIPPED\n# no UTF-8 locales\n"),exit; +} +use warnings 'locale'; +use locale; +setlocale(&POSIX::LC_CTYPE, $utf8_locales[0]); +"\x{100}" =~ /\x{100}|\x{101}/il; +"\x{100}" =~ /\x{100}|\x{101}/l; +"\x{100}" =~ /\w/l; +"\x{100}" =~ /\x{100}+/l; +"\x{100}" =~ /[\x{100}\x{102}]/l; +EXPECT +######## # NAME \b{} in non-UTF-8 locale eval { require POSIX; POSIX->import("locale_h") }; if ($@) { diff --git a/t/lib/warnings/utf8 b/t/lib/warnings/utf8 index d8f301d..2dfb4cb 100644 --- a/t/lib/warnings/utf8 +++ b/t/lib/warnings/utf8 @@ -648,3 +648,28 @@ Wide character (U+101) in lcfirst at - line 15. Wide character (U+102) in fc at - line 16. Wide character (U+103) in uc at - line 17. Wide character (U+104) in ucfirst at - line 18. +######## +# NAME Wide character in UTF-8 locale +require '../loc_tools.pl'; +unless (locales_enabled('LC_CTYPE')) { + print("SKIPPED\n# locales not available\n"),exit; +} +eval { require POSIX; POSIX->import("locale_h") }; +if ($@) { + print("SKIPPED\n# no POSIX\n"),exit; +} +my @utf8_locales = find_utf8_ctype_locale(); +unless (@utf8_locales) { + print("SKIPPED\n# no UTF-8 locales\n"),exit; +} +use warnings 'locale'; +use feature 'fc'; +use locale; +setlocale(&POSIX::LC_CTYPE, $utf8_locales[0]); +my $a; +$a = lc("\x{100}"); +$a = lcfirst("\x{101}"); +$a = fc("\x{102}"); +$a = uc("\x{103}"); +$a = ucfirst("\x{104}"); +EXPECT -- Perl5 Master Repository
