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