Upgrade to Encode 2.00.
[p5sagit/p5-mst-13.2.git] / ext / Encode / t / enc_utf8.t
CommitLineData
7237418a 1# $Id: enc_utf8.t,v 2.0 2004/05/16 20:55:18 dankogai Exp $
cc7dbc11 2# This is the twin of enc_eucjp.t .
88632417 3
06fb145c 4BEGIN {
5 require Config; import Config;
6 if ($Config{'extensions'} !~ /\bEncode\b/) {
7 print "1..0 # Skip: Encode was not built\n";
8 exit 0;
9 }
10 unless (find PerlIO::Layer 'perlio') {
11 print "1..0 # Skip: PerlIO was not built\n";
12 exit 0;
13 }
14 if (ord("A") == 193) {
15 print "1..0 # encoding pragma does not support EBCDIC platforms\n";
16 exit(0);
17 }
18}
19
20use encoding 'utf8';
21
22my @c = (127, 128, 255, 256);
23
24print "1.." . (scalar @c + 1) . "\n";
25
26my @f;
27
28for my $i (0..$#c) {
3cd78934 29 my $file = filename("f$i");
30 push @f, $file;
31 open(F, ">$file") or die "$0: failed to open '$file' for writing: $!";
06fb145c 32 binmode(F, ":utf8");
33 print F chr($c[$i]);
34 close F;
35}
36
37my $t = 1;
38
39for my $i (0..$#c) {
3cd78934 40 my $file = filename("f$i");
41 open(F, "<$file") or die "$0: failed to open '$file' for reading: $!";
06fb145c 42 binmode(F, ":utf8");
43 my $c = <F>;
44 my $o = ord($c);
fa6f41cf 45 print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$i]: $o != $c[$i]\n";
06fb145c 46 $t++;
47}
48
3cd78934 49my $f = filename("f" . @f);
06fb145c 50
51push @f, $f;
52open(F, ">$f") or die "$0: failed to open '$f' for writing: $!";
53binmode(F, ":raw"); # Output raw bytes.
54print F chr(128); # Output illegal UTF-8.
55close F;
56open(F, $f) or die "$0: failed to open '$f' for reading: $!";
57binmode(F, ":encoding(utf-8)");
58{
59 local $^W = 1;
60 local $SIG{__WARN__} = sub { $a = shift };
61 eval { <F> }; # This should get caught.
62}
cc7dbc11 63close F;
06fb145c 64print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ?
88632417 65 "ok $t - illegal utf8 input\n" : "not ok $t - illegal utf8 input: a = " . unpack("H*", $a) . "\n";
06fb145c 66
3cd78934 67# On VMS temporary file names like "f0." may be more readable than "f0" since
68# "f0" could be a logical name pointing elsewhere.
69sub filename {
70 my $name = shift;
71 $name .= '.' if $^O eq 'VMS';
72 return $name;
73}
74
06fb145c 75END {
76 1 while unlink @f;
77}