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 | |
19 | if (open(GRK, ">$grk")) { |
20 | # alpha beta gamma in ISO 8859-7 |
21 | print GRK "\xe1\xe2\xe3"; |
22 | close GRK; |
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"; |
33 | close($o); |
34 | close($i); |
35 | } |
36 | |
37 | if (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 |
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"; |
52 | close($o); |
53 | close($i); |
54 | } |
55 | |
56 | if (open(GRK, "<$grk")) { |
57 | print "not " unless <GRK> eq "\xe1\xe2\xe3"; |
58 | print "ok 8\n"; |
206b12d5 |
59 | close GRK; |
8e86646e |
60 | } |
61 | |
b26b1ab5 |
62 | $SIG{__WARN__} = sub {$warn = $_[0]}; |
63 | |
64 | if (open(FAIL, ">:encoding(NoneSuch)", $fail1)) { |
65 | print "not ok 9 # Open should fail\n"; |
66 | } else { |
67 | print "ok 9\n"; |
68 | } |
69 | if (!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 |
77 | if (open(RUSSKI, ">$russki")) { |
78 | print RUSSKI "\x3c\x3f\x78"; |
79 | close RUSSKI; |
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 |
100 | END { |
ed53a2bb |
101 | unlink($grk, $utf, $fail1, $russki); |
8e86646e |
102 | } |