perldelta for 85d4e0a35b2d
[perl.git] / cpan / Encode / t / enc_utf8.t
1 # $Id: enc_utf8.t,v 2.5 2017/06/10 17:23:50 dankogai Exp $
2 # This is the twin of enc_eucjp.t .
3
4 BEGIN {
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     if ($] >= 5.025003 and !$Config{usecperl}){
19     print "1..0 # Skip: Perl <=5.25.2 or cperl required\n";
20     exit 0;
21     }
22 }
23
24 no warnings "deprecated";
25 use encoding 'utf8';
26
27 my @c = (127, 128, 255, 256);
28
29 print "1.." . (scalar @c + 2) . "\n";
30
31 my @f;
32
33 for my $i (0..$#c) {
34   my $file = filename("f$i");
35   push @f, $file;
36   open(F, ">$file") or die "$0: failed to open '$file' for writing: $!";
37   binmode(F, ":utf8");
38   print F chr($c[$i]);
39   close F;
40 }
41
42 my $t = 1;
43
44 for my $i (0..$#c) {
45   my $file = filename("f$i");
46   open(F, "<$file") or die "$0: failed to open '$file' for reading: $!";
47   binmode(F, ":utf8");
48   my $c = <F>;
49   my $o = ord($c);
50   print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$i]: $o != $c[$i]\n";
51   $t++;
52 }
53
54 my $f = filename("f" . @f);
55
56 push @f, $f;
57 open(F, ">$f") or die "$0: failed to open '$f' for writing: $!";
58 binmode(F, ":raw"); # Output raw bytes.
59 print F chr(128); # Output illegal UTF-8.
60 close F;
61 open(F, $f) or die "$0: failed to open '$f' for reading: $!";
62 binmode(F, ":encoding(UTF-8)");
63 {
64     local $^W = 1;
65     local $SIG{__WARN__} = sub { $a = shift };
66     eval { <F> }; # This should get caught.
67 }
68 close F;
69 print $a =~ qr{^UTF-8 "\\x80" does not map to Unicode} ?
70   "ok $t - illegal UTF-8 input\n" : "not ok $t - illegal UTF-8 input: a = " . unpack("H*", $a) . "\n";
71 $t++;
72
73 open(F, $f) or die "$0: failed to open '$f' for reading: $!";
74 binmode(F, ":encoding(utf8)");
75 {
76     local $^W = 1;
77     local $SIG{__WARN__} = sub { $a = shift };
78     eval { <F> }; # This should get caught.
79 }
80 close F;
81 print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ?
82   "ok $t - illegal utf8 input\n" : "not ok $t - illegal utf8 input: a = " . unpack("H*", $a) . "\n";
83 $t++;
84
85 # On VMS temporary file names like "f0." may be more readable than "f0" since
86 # "f0" could be a logical name pointing elsewhere.
87 sub filename {
88     my $name = shift;
89     $name .= '.' if $^O eq 'VMS';
90     return $name;
91 }
92
93 END {
94   1 while unlink @f;
95 }