diff options
author | Karl Williamson <public@khwilliamson.com> | 2013-12-31 21:45:54 -0700 |
---|---|---|
committer | Karl Williamson <public@khwilliamson.com> | 2014-01-01 13:49:24 -0700 |
commit | 54f4afefabe5f838538f462f1e2bb40a64b6bb77 (patch) | |
tree | eeeb292ec3148f721dad4964d36549386a406856 | |
parent | 0cfa64bfe0ab570e7b2ddddfdad71f8341a5e6e1 (diff) | |
download | perl-54f4afefabe5f838538f462f1e2bb40a64b6bb77.tar.gz |
utf8.c: Fix warning category and subcategory conflicts
The warnings categories non_unicode, nonchar, and surrogate are all
subcategories of 'utf8'. One should never call a packWARN() with both a
category and a subcategory of it, as it will mean that one can't
completely make the subcategory independent. For example,
use warnings 'utf8';
no warnings 'surrogate';
surrogate warnings will be output if they are tested with a
ckWARN2(WARN_UTF8, WARN_SURROGATE);
utf8.c was guilty of this.
-rw-r--r-- | ext/XS-APItest/t/utf8.t | 25 | ||||
-rw-r--r-- | pod/perldiag.pod | 2 | ||||
-rw-r--r-- | utf8.c | 12 |
3 files changed, 22 insertions, 17 deletions
diff --git a/ext/XS-APItest/t/utf8.t b/ext/XS-APItest/t/utf8.t index 6a6ed9eaf4..b052a8633e 100644 --- a/ext/XS-APItest/t/utf8.t +++ b/ext/XS-APItest/t/utf8.t @@ -202,12 +202,16 @@ foreach my $test (@tests) { # are several orthogonal variables involved. We test all the subclasses # of utf8 warnings to verify they work with and without the utf8 class, # and don't have effects on other sublass warnings - foreach my $warning (0, 'utf8', 'surrogate', 'nonchar', 'non_unicode') { + foreach my $warning ('utf8', 'surrogate', 'nonchar', 'non_unicode') { foreach my $warn_flag (0, $warn_flags) { foreach my $disallow_flag (0, $disallow_flags) { + foreach my $do_warning (0, 1) { - no warnings 'utf8'; - my $eval_warn = $warning eq 0 ? "no warnings" : "use warnings '$warning'"; + my $eval_warn = $do_warning + ? "use warnings '$warning'" + : $warning eq "utf8" + ? "no warnings 'utf8'" + : "use warnings 'utf8'; no warnings '$warning'"; # is effectively disallowed if will overflow, even if the flag # indicates it is allowed, fix up test name to indicate this @@ -239,7 +243,13 @@ foreach my $test (@tests) { } is($ret_ref->[1], $expected_len, "$this_name: Returns expected length"); - if ($will_overflow && ! $disallow_flag && $warning eq 'utf8') { + if (! $do_warning && ($warning eq 'utf8' || $warning eq $category)) { + if (!is(scalar @warnings, 0, "$this_name: No warnings generated")) + { + note "The warnings were: " . join(", ", @warnings); + } + } + elsif ($will_overflow && ! $disallow_flag && $warning eq 'utf8') { # Will get the overflow message instead of the expected # message under these circumstances, as they would @@ -264,12 +274,6 @@ foreach my $test (@tests) { } } } - else { - if (!is(scalar @warnings, 0, "$this_name: No warnings generated")) - { - note "The warnings were: " . join(", ", @warnings); - } - } # Check CHECK_ONLY results when the input is disallowed. Do # this when actually disallowed, not just when the @@ -285,6 +289,7 @@ foreach my $test (@tests) { } } } + } } } diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 61d144ab2e..207f55c5f2 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3672,7 +3672,7 @@ the C<fallback> overloading key is specified to be true. See L<overload>. =item Operation "%s" returns its argument for non-Unicode code point 0x%X -(S utf8, non_unicode) You performed an operation requiring Unicode +(S non_unicode) You performed an operation requiring Unicode semantics on a code point that is not in Unicode, so what it should do is not defined. Perl has chosen to have it do nothing, and warn you. @@ -831,10 +831,10 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags) { if (UNICODE_IS_SURROGATE(uv)) { if ((flags & (UTF8_WARN_SURROGATE|UTF8_CHECK_ONLY)) == UTF8_WARN_SURROGATE - && ckWARN2_d(WARN_UTF8, WARN_SURROGATE)) + && ckWARN_d(WARN_SURROGATE)) { sv = sv_2mortal(Perl_newSVpvf(aTHX_ "UTF-16 surrogate U+%04"UVXf"", uv)); - pack_warn = packWARN2(WARN_UTF8, WARN_SURROGATE); + pack_warn = packWARN(WARN_SURROGATE); } if (flags & UTF8_DISALLOW_SURROGATE) { goto disallowed; @@ -842,10 +842,10 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags) } else if ((uv > PERL_UNICODE_MAX)) { if ((flags & (UTF8_WARN_SUPER|UTF8_CHECK_ONLY)) == UTF8_WARN_SUPER - && ckWARN2_d(WARN_UTF8, WARN_NON_UNICODE)) + && ckWARN_d(WARN_NON_UNICODE)) { sv = sv_2mortal(Perl_newSVpvf(aTHX_ "Code point 0x%04"UVXf" is not Unicode, may not be portable", uv)); - pack_warn = packWARN2(WARN_UTF8, WARN_NON_UNICODE); + pack_warn = packWARN(WARN_NON_UNICODE); } if (flags & UTF8_DISALLOW_SUPER) { goto disallowed; @@ -853,10 +853,10 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags) } else if (UNICODE_IS_NONCHAR(uv)) { if ((flags & (UTF8_WARN_NONCHAR|UTF8_CHECK_ONLY)) == UTF8_WARN_NONCHAR - && ckWARN2_d(WARN_UTF8, WARN_NONCHAR)) + && ckWARN_d(WARN_NONCHAR)) { sv = sv_2mortal(Perl_newSVpvf(aTHX_ "Unicode non-character U+%04"UVXf" is illegal for open interchange", uv)); - pack_warn = packWARN2(WARN_UTF8, WARN_NONCHAR); + pack_warn = packWARN(WARN_NONCHAR); } if (flags & UTF8_DISALLOW_NONCHAR) { goto disallowed; |