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