This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
warnings for perlio + others
[perl5.git] / ext / PerlIO / t / encoding.t
CommitLineData
9ba8831b
JH
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 unless (find PerlIO::Layer 'perlio') {
7 print "1..0 # Skip: not perlio\n";
8 exit 0;
9 }
10}
11
ed53a2bb 12print "1..11\n";
08efa405 13
8e86646e
JH
14my $grk = "grk$$";
15my $utf = "utf$$";
b26b1ab5 16my $fail1 = "fail$$";
ed53a2bb 17my $russki = "koi8r$$";
8e86646e
JH
18
19if (open(GRK, ">$grk")) {
20 # alpha beta gamma in ISO 8859-7
21 print GRK "\xe1\xe2\xe3";
d1e4d418 22 close GRK or die "Could not close: $!";
8e86646e
JH
23}
24
25{
26 use Encode;
27 open(my $i,'<:encoding(iso-8859-7)',$grk);
28 print "ok 1\n";
29 open(my $o,'>:utf8',$utf);
30 print "ok 2\n";
31 print $o readline($i);
32 print "ok 3\n";
d1e4d418 33 close($o) or die "Could not close: $!";
8e86646e
JH
34 close($i);
35}
36
37if (open(UTF, "<$utf")) {
07229bbd
JH
38 if (ord('A') == 193) { # EBCDIC
39 # alpha beta gamma in UTF-EBCDIC Unicode (0x3b1 0x3b2 0x3b3)
40 print "not " unless <UTF> eq "\xb4\x58\xb4\x59\xb4\x62";
41 } else {
42 # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3)
43 print "not " unless <UTF> eq "\xce\xb1\xce\xb2\xce\xb3";
44 }
8e86646e 45 print "ok 4\n";
206b12d5 46 close UTF;
8e86646e
JH
47}
48
49{
50 use Encode;
51 open(my $i,'<:utf8',$utf);
52 print "ok 5\n";
53 open(my $o,'>:encoding(iso-8859-7)',$grk);
54 print "ok 6\n";
55 print $o readline($i);
56 print "ok 7\n";
d1e4d418 57 close($o) or die "Could not close: $!";
8e86646e
JH
58 close($i);
59}
60
61if (open(GRK, "<$grk")) {
62 print "not " unless <GRK> eq "\xe1\xe2\xe3";
63 print "ok 8\n";
206b12d5 64 close GRK;
8e86646e
JH
65}
66
b26b1ab5
NC
67$SIG{__WARN__} = sub {$warn = $_[0]};
68
69if (open(FAIL, ">:encoding(NoneSuch)", $fail1)) {
70 print "not ok 9 # Open should fail\n";
71} else {
72 print "ok 9\n";
73}
74if (!defined $warn) {
75 print "not ok 10 # warning is undef\n";
76} elsif ($warn =~ /^Cannot find encoding "NoneSuch" at/) {
77 print "ok 10\n";
78} else {
79 print "not ok 10 # warning is '$warn'";
80}
81
ed53a2bb
JH
82if (open(RUSSKI, ">$russki")) {
83 print RUSSKI "\x3c\x3f\x78";
d1e4d418 84 close RUSSKI or die "Could not close: $!";
ed53a2bb
JH
85 open(RUSSKI, "$russki");
86 binmode(RUSSKI, ":raw");
87 my $buf1;
88 read(RUSSKI, $buf1, 1);
89 eof(RUSSKI);
90 binmode(RUSSKI, ":encoding(koi8-r)");
91 my $buf2;
92 read(RUSSKI, $buf2, 1);
93 my $offset = tell(RUSSKI);
07229bbd
JH
94 if (ord($buf1) == 0x3c &&
95 ord($buf2) == (ord('A') == 193) ? 0x6f : 0x3f &&
96 $offset == 2) {
ed53a2bb
JH
97 print "ok 11\n";
98 } else {
07229bbd
JH
99 printf "not ok 11 # [%s] [%s] %d\n",
100 join(" ", unpack("H*", $buf1)),
101 join(" ", unpack("H*", $buf2)), $offset;
ed53a2bb
JH
102 }
103 close(RUSSKI);
104} else {
105 print "not ok 11 # open failed: $!\n";
106}
107
8e86646e 108END {
ed53a2bb 109 unlink($grk, $utf, $fail1, $russki);
8e86646e 110}