Change 14505 by jhi@alpha on 2002/01/31 15:26:41
Turn the I/O Unicode error by default on, but the
character-generating Unicode error by default off,
as Larry suggested.
Affected files ...
.... //depot/perl/doio.c#189 edit
.... //depot/perl/pod/perldiag.pod#267 edit
.... //depot/perl/pp.c#332 edit
.... //depot/perl/t/io/utf8.t#22 edit
.... //depot/perl/t/lib/warnings/utf8#6 edit
.... //depot/perl/utf8.c#156 edit
Differences ...
==== //depot/perl/doio.c#189 (text) ====
Index: perl/doio.c
--- perl/doio.c.~1~ Thu Jan 31 08:30:05 2002
+++ perl/doio.c Thu Jan 31 08:30:05 2002
@@ -1223,7 +1223,7 @@
}
else if (DO_UTF8(sv)) {
if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)
- && ckWARN(WARN_UTF8))
+ && ckWARN_d(WARN_UTF8))
{
Perl_warner(aTHX_ WARN_UTF8, "Wide character in print");
}
==== //depot/perl/pod/perldiag.pod#267 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod.~1~ Thu Jan 31 08:30:05 2002
+++ perl/pod/perldiag.pod Thu Jan 31 08:30:05 2002
@@ -4184,7 +4184,10 @@
=item Wide character in %s
-(W utf8) Perl met a wide character (>255) when it wasn't expecting one.
+(W utf8) Perl met a wide character (>255) when it wasn't expecting
+one. This warning is by default on for I/O (like print) but can be
+turned off by C<no warnings 'utf8';>. You are supposed to explicitly
+mark the filehandle with an encoding, see L<open> and L<perlfunc/binmode>.
=item write() on closed filehandle %s
==== //depot/perl/pp.c#332 (text) ====
Index: perl/pp.c
--- perl/pp.c.~1~ Thu Jan 31 08:30:05 2002
+++ perl/pp.c Thu Jan 31 08:30:05 2002
@@ -3168,8 +3168,7 @@
if (value > 255 && !IN_BYTES) {
SvGROW(TARG, UNISKIP(value)+1);
- tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value,
- UNICODE_ALLOW_SUPER);
+ tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value, 0);
SvCUR_set(TARG, tmps - SvPVX(TARG));
*tmps = '\0';
(void)SvPOK_only(TARG);
==== //depot/perl/t/io/utf8.t#22 (xtext) ====
Index: perl/t/io/utf8.t
--- perl/t/io/utf8.t.~1~ Thu Jan 31 08:30:05 2002
+++ perl/t/io/utf8.t Thu Jan 31 08:30:05 2002
@@ -12,7 +12,7 @@
no utf8; # needed for use utf8 not griping about the raw octets
$| = 1;
-print "1..26\n";
+print "1..31\n";
open(F,"+>:utf8",'a');
print F chr(0x100).'�';
@@ -186,7 +186,7 @@
close F;
unlink('a');
-open F, ">a";
+open F, ">:utf8", "a";
@a = map { chr(1 << ($_ << 2)) } 0..5; # 0x1, 0x10, .., 0x100000
unshift @a, chr(0); # ... and a null byte in front just for fun
print F @a;
@@ -216,6 +216,52 @@
close F;
print "ok 26\n";
+{
+ # Check that warnings are on on I/O, and that they can be muffled.
+
+ local $SIG{__WARN__} = sub { $@ = shift };
+
+ undef $@;
+ open F, ">a";
+ print F chr(0x100);
+ close(F);
+
+ print $@ =~ /Wide character in print/ ? "ok 27\n" : "not ok 27\n";
+
+ undef $@;
+ open F, ">:utf8", ">a";
+ print F chr(0x100);
+ close(F);
+
+ print defined $@ ? "not ok 28\n" : "ok 28\n";
+
+ undef $@;
+ open F, ">a";
+ binmode(F, ":utf8");
+ print F chr(0x100);
+ close(F);
+
+ print defined $@ ? "not ok 29\n" : "ok 29\n";
+
+ no warnings 'utf8';
+
+ undef $@;
+ open F, ">a";
+ print F chr(0x100);
+ close(F);
+
+ print defined $@ ? "not ok 30\n" : "ok 30\n";
+
+ use warnings 'utf8';
+
+ undef $@;
+ open F, ">a";
+ print F chr(0x100);
+ close(F);
+
+ print $@ =~ /Wide character in print/ ? "ok 31\n" : "not ok 31\n";
+}
+
# sysread() and syswrite() tested in lib/open.t since Fnctl is used
END {
@@ -223,4 +269,3 @@
1 while unlink "b";
}
-
==== //depot/perl/t/lib/warnings/utf8#6 (text) ====
Index: perl/t/lib/warnings/utf8
--- perl/t/lib/warnings/utf8.~1~ Thu Jan 31 08:30:05 2002
+++ perl/t/lib/warnings/utf8 Thu Jan 31 08:30:05 2002
@@ -34,15 +34,88 @@
Malformed UTF-8 character (unexpected non-continuation byte 0x73, immediately after
start byte 0xf8) at - line 14.
########
use warnings 'utf8';
-my $surr = chr(0xD800);
-my $fff3 = chr(0xFFFE);
-my $ffff = chr(0xFFFF);
+my $d7ff = chr(0xD7FF);
+my $d800 = chr(0xD800);
+my $dfff = chr(0xDFFF);
+my $e000 = chr(0xE000);
+my $fffd = chr(0xFFFD);
+my $fffe = chr(0xFFFE);
+my $ffff = chr(0xFFFF);
+my $hex4 = chr(0x10000);
+my $hex5 = chr(0x100000);
+my $max = chr(0x10FFFF);
+no warnings 'utf8';
+my $d7ff = chr(0xD7FF);
+my $d800 = chr(0xD800);
+my $dfff = chr(0xDFFF);
+my $e000 = chr(0xE000);
+my $fffd = chr(0xFFFD);
+my $fffe = chr(0xFFFE);
+my $ffff = chr(0xFFFF);
+my $hex4 = chr(0x10000);
+my $hex5 = chr(0x100000);
+my $max = chr(0x10FFFF);
+EXPECT
+UTF-16 surrogate 0xd800 at - line 3.
+UTF-16 surrogate 0xdfff at - line 4.
+Unicode character 0xfffe is illegal at - line 7.
+Unicode character 0xffff is illegal at - line 8.
+Unicode character 0x10ffff is illegal at - line 11.
+########
+use warnings 'utf8';
+my $d7ff = pack("U", 0xD7FF);
+my $d800 = pack("U", 0xD800);
+my $dfff = pack("U", 0xDFFF);
+my $e000 = pack("U", 0xE000);
+my $fffd = pack("U", 0xFFFD);
+my $fffe = pack("U", 0xFFFE);
+my $ffff = pack("U", 0xFFFF);
+my $hex4 = pack("U", 0x10000);
+my $hex5 = pack("U", 0x100000);
+my $max = pack("U", 0x10FFFF);
no warnings 'utf8';
-$surr = chr(0xD800);
-$fffe = chr(0xFFFE);
-$ffff = chr(0xFFFF);
+my $d7ff = pack("U", 0xD7FF);
+my $d800 = pack("U", 0xD800);
+my $dfff = pack("U", 0xDFFF);
+my $e000 = pack("U", 0xE000);
+my $fffd = pack("U", 0xFFFD);
+my $fffe = pack("U", 0xFFFE);
+my $ffff = pack("U", 0xFFFF);
+my $hex4 = pack("U", 0x10000);
+my $hex5 = pack("U", 0x100000);
+my $max = pack("U", 0x10FFFF);
EXPECT
-UTF-16 surrogate 0xd800 at - line 2.
-Unicode character 0xfffe is illegal at - line 3.
-Unicode character 0xffff is illegal at - line 4.
+UTF-16 surrogate 0xd800 at - line 3.
+UTF-16 surrogate 0xdfff at - line 4.
+Unicode character 0xfffe is illegal at - line 7.
+Unicode character 0xffff is illegal at - line 8.
+Unicode character 0x10ffff is illegal at - line 11.
########
+use warnings 'utf8';
+my $d7ff = "\x{D7FF}";
+my $d800 = "\x{D800}";
+my $dfff = "\x{DFFF}";
+my $e000 = "\x{E000}";
+my $fffd = "\x{FFFD}";
+my $fffe = "\x{FFFE}";
+my $ffff = "\x{FFFF}";
+my $hex4 = "\x{10000}";
+my $hex5 = "\x{100000}";
+my $max = "\x{10FFFF}";
+no warnings 'utf8';
+my $d7ff = "\x{D7FF}";
+my $d800 = "\x{D800}";
+my $dfff = "\x{DFFF}";
+my $e000 = "\x{E000}";
+my $fffd = "\x{FFFD}";
+my $fffe = "\x{FFFE}";
+my $ffff = "\x{FFFF}";
+my $hex4 = "\x{10000}";
+my $hex5 = "\x{100000}";
+my $max = "\x{10FFFF}";
+EXPECT
+UTF-16 surrogate 0xd800 at - line 3.
+UTF-16 surrogate 0xdfff at - line 4.
+Unicode character 0xfffe is illegal at - line 7.
+Unicode character 0xffff is illegal at - line 8.
+Unicode character 0x10ffff is illegal at - line 11.
==== //depot/perl/utf8.c#156 (text) ====
Index: perl/utf8.c
--- perl/utf8.c.~1~ Thu Jan 31 08:30:05 2002
+++ perl/utf8.c Thu Jan 31 08:30:05 2002
@@ -54,7 +54,7 @@
U8 *
Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
{
- if (ckWARN_d(WARN_UTF8)) {
+ if (ckWARN(WARN_UTF8)) {
if (UNICODE_IS_SURROGATE(uv) &&
!(flags & UNICODE_ALLOW_SURROGATE))
Perl_warner(aTHX_ WARN_UTF8, "UTF-16 surrogate 0x%04"UVxf, uv);
End of Patch.
