diff options
| -rw-r--r-- | pod/perldiag.pod | 17 | ||||
| -rw-r--r-- | t/lib/warnings/utf8 | 13 | ||||
| -rwxr-xr-x | t/op/ord.t | 11 | ||||
| -rw-r--r-- | utf8.c | 13 |
4 files changed, 33 insertions, 21 deletions
diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 83baed2745..1935550821 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3605,8 +3605,9 @@ representative, who probably put it there in the first place. =item Unicode character %s is illegal -Certain Unicode characters have been designated off-limits by the -Unicode standard and should not be generated. +(W utf8) Certain Unicode characters have been designated off-limits by +the Unicode standard and should not be generated. If you really know +what you are doing you can turn off this warning by C<no warnings 'utf8';>. =item Unknown BYTEORDER @@ -4004,11 +4005,13 @@ removed in a future version. =item UTF-16 surrogate %s -(F) You tried to generate half of an UTF-16 surrogate by requesting -a Unicode character between the code points 0xD800 and 0xDFFF (inclusive). -That range is reserved exclusively for the use of UTF-16 encoding -(by having two 16-bit UCS-2 characters); but Perl encodes its characters -in UTF-8, so what you got is a very illegal character. +(W utf8) You tried to generate half of an UTF-16 surrogate by +requesting a Unicode character between the code points 0xD800 and +0xDFFF (inclusive). That range is reserved exclusively for the use of +UTF-16 encoding (by having two 16-bit UCS-2 characters); but Perl +encodes its characters in UTF-8, so what you got is a very illegal +character. If you really know what you are doing you can turn off +this warning by C<no warnings 'utf8';>. =item Value of %s can be "0"; test with defined() diff --git a/t/lib/warnings/utf8 b/t/lib/warnings/utf8 index 9a7dbafdee..fa7041b938 100644 --- a/t/lib/warnings/utf8 +++ b/t/lib/warnings/utf8 @@ -33,3 +33,16 @@ EXPECT Malformed UTF-8 character (unexpected non-continuation byte 0x73 after start byte 0xf8) at - line 9. Malformed UTF-8 character (unexpected non-continuation byte 0x73 after start byte 0xf8) at - line 14. ######## +use warnings 'utf8'; +my $surr = chr(0xD800); +my $fff3 = chr(0xFFFE); +my $ffff = chr(0xFFFF); +no warnings 'utf8'; +$surr = chr(0xD800); +$fffe = chr(0xFFFE); +$ffff = chr(0xFFFF); +EXPECT +UTF-16 surrogate 0xd800 at - line 2. +Unicode character 0xfffe is illegal at - line 3. +Unicode character 0xffff is illegal at - line 4. +######## diff --git a/t/op/ord.t b/t/op/ord.t index f7460553cc..ff51c18f8c 100755 --- a/t/op/ord.t +++ b/t/op/ord.t @@ -2,11 +2,11 @@ BEGIN { chdir 't' if -d 't'; - @INC = '.'; + @INC = qw(.); require "test.pl"; } -print "1..8\n"; +plan tests => 7; # compile time evaluation @@ -33,10 +33,3 @@ is(ord("\x{1234}"), 0x1234, 'compile time ord \x{....}'); $x = "\x{1234}"; is(ord($x), 0x1234, 'runtime ord \x{....}'); -{ - eval 'my $surrogate = chr(0xD800)'; - - like($@, qr/^UTF-16 surrogate 0xd800 /, "surrogates bad"); -} - - @@ -46,11 +46,14 @@ is the recommended Unicode-aware way of saying U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv) { - if (UNICODE_IS_SURROGATE(uv)) - Perl_croak(aTHX_ "UTF-16 surrogate 0x%04"UVxf, uv); - else if ((uv >= 0xFDD0 && uv <= 0xFDEF) || - (uv == 0xFFFE || uv == 0xFFFF)) - Perl_croak(aTHX_ "Unicode character 0x%04"UVxf" is illegal", uv); + if (ckWARN_d(WARN_UTF8)) { + if (UNICODE_IS_SURROGATE(uv)) + Perl_warner(aTHX_ WARN_UTF8, "UTF-16 surrogate 0x%04"UVxf, uv); + else if ((uv >= 0xFDD0 && uv <= 0xFDEF) || + (uv == 0xFFFE || uv == 0xFFFF)) + Perl_warner(aTHX_ WARN_UTF8, + "Unicode character 0x%04"UVxf" is illegal", uv); + } if (UNI_IS_INVARIANT(uv)) { *d++ = UTF_TO_NATIVE(uv); return d; |