This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
chr(42) ne '*' if one is in EBCDIC.
[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")) {
38 # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3)
39 print "not " unless <UTF> eq "\xce\xb1\xce\xb2\xce\xb3";
40 print "ok 4\n";
206b12d5 41 close UTF;
8e86646e
JH
42}
43
44{
45 use Encode;
46 open(my $i,'<:utf8',$utf);
47 print "ok 5\n";
48 open(my $o,'>:encoding(iso-8859-7)',$grk);
49 print "ok 6\n";
50 print $o readline($i);
51 print "ok 7\n";
d1e4d418 52 close($o) or die "Could not close: $!";
8e86646e
JH
53 close($i);
54}
55
56if (open(GRK, "<$grk")) {
57 print "not " unless <GRK> eq "\xe1\xe2\xe3";
58 print "ok 8\n";
206b12d5 59 close GRK;
8e86646e
JH
60}
61
b26b1ab5
NC
62$SIG{__WARN__} = sub {$warn = $_[0]};
63
64if (open(FAIL, ">:encoding(NoneSuch)", $fail1)) {
65 print "not ok 9 # Open should fail\n";
66} else {
67 print "ok 9\n";
68}
69if (!defined $warn) {
70 print "not ok 10 # warning is undef\n";
71} elsif ($warn =~ /^Cannot find encoding "NoneSuch" at/) {
72 print "ok 10\n";
73} else {
74 print "not ok 10 # warning is '$warn'";
75}
76
ed53a2bb
JH
77if (open(RUSSKI, ">$russki")) {
78 print RUSSKI "\x3c\x3f\x78";
d1e4d418 79 close RUSSKI or die "Could not close: $!";
ed53a2bb
JH
80 open(RUSSKI, "$russki");
81 binmode(RUSSKI, ":raw");
82 my $buf1;
83 read(RUSSKI, $buf1, 1);
84 eof(RUSSKI);
85 binmode(RUSSKI, ":encoding(koi8-r)");
86 my $buf2;
87 read(RUSSKI, $buf2, 1);
88 my $offset = tell(RUSSKI);
89 if (ord($buf1) == 0x3c && ord($buf2) == 0x3f && $offset == 2) {
90 print "ok 11\n";
91 } else {
92 printf "not ok 11 # %#x %#x %d\n",
93 ord($buf1), ord($buf2), $offset;
94 }
95 close(RUSSKI);
96} else {
97 print "not ok 11 # open failed: $!\n";
98}
99
8e86646e 100END {
ed53a2bb 101 unlink($grk, $utf, $fail1, $russki);
8e86646e 102}