6 no warnings; # Need global -w flag for later tests, but don't want this
8 push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
9 unless (find PerlIO::Layer 'perlio') {
10 print "1..0 # Skip: not perlio\n";
13 unless (eval { require Encode } ) {
14 print "1..0 # Skip: not Encode\n";
25 my $russki = "koi8r$$";
26 my $threebyte = "3byte$$";
28 if (open(GRK, ">$grk")) {
29 binmode(GRK, ":bytes");
30 # alpha beta gamma in ISO 8859-7
31 print GRK "\xe1\xe2\xe3";
32 close GRK or die "Could not close: $!";
36 open(my $i,'<:encoding(iso-8859-7)',$grk);
38 open(my $o,'>:utf8',$utf);
40 print $o readline($i);
42 close($o) or die "Could not close: $!";
46 if (open(UTF, "<$utf")) {
47 binmode(UTF, ":bytes");
48 if (ord('A') == 193) { # EBCDIC
49 # alpha beta gamma in UTF-EBCDIC Unicode (0x3b1 0x3b2 0x3b3)
50 print "not " unless <UTF> eq "\xb4\x58\xb4\x59\xb4\x62";
52 # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3)
53 print "not " unless <UTF> eq "\xce\xb1\xce\xb2\xce\xb3";
61 open(my $i,'<:utf8',$utf);
63 open(my $o,'>:encoding(iso-8859-7)',$grk);
65 print $o readline($i);
67 close($o) or die "Could not close: $!";
71 if (open(GRK, "<$grk")) {
72 binmode(GRK, ":bytes");
73 print "not " unless <GRK> eq "\xe1\xe2\xe3";
78 $SIG{__WARN__} = sub {$warn .= $_[0]};
80 if (open(FAIL, ">:encoding(NoneSuch)", $fail1)) {
81 print "not ok 9 # Open should fail\n";
86 print "not ok 10 # warning is undef\n";
87 } elsif ($warn =~ /^Cannot find encoding "NoneSuch" at/) {
90 print "not ok 10 # warning is '$warn'";
93 if (open(RUSSKI, ">$russki")) {
94 print RUSSKI "\x3c\x3f\x78";
95 close RUSSKI or die "Could not close: $!";
96 open(RUSSKI, "$russki");
97 binmode(RUSSKI, ":raw");
99 read(RUSSKI, $buf1, 1);
101 binmode(RUSSKI, ":encoding(koi8-r)");
103 read(RUSSKI, $buf2, 1);
104 my $offset = tell(RUSSKI);
105 if (ord($buf1) == 0x3c &&
106 ord($buf2) == (ord('A') == 193) ? 0x6f : 0x3f &&
110 printf "not ok 11 # [%s] [%s] %d\n",
111 join(" ", unpack("H*", $buf1)),
112 join(" ", unpack("H*", $buf2)), $offset;
116 print "not ok 11 # open failed: $!\n";
121 # Check there is no Use of uninitialized value in concatenation (.) warning
122 # due to the way @latin2iso_num was used to make aliases.
123 if (open(FAIL, ">:encoding(latin42)", $fail2)) {
124 print "not ok 12 # Open should fail\n";
128 if (!defined $warn) {
129 print "not ok 13 # warning is undef\n";
130 } elsif ($warn =~ /^Cannot find encoding "latin42" at.*line \d+\.$/) {
133 print "not ok 13 # warning is: \n";
138 # Create a string of chars that are 3 bytes in UTF-8
139 my $str = "\x{1f80}" x 2048;
141 # Write them to a file
142 open(F,'>:utf8',$threebyte) || die "Cannot open $threebyte:$!";
146 # Read file back as UTF-8
147 open(F,'<:encoding(utf-8)',$threebyte) || die "Cannot open $threebyte:$!";
150 print "not " unless ($dstr eq $str);
153 # Try decoding some bad stuff
154 open(F,'>:raw',$threebyte) || die "Cannot open $threebyte:$!";
155 print F "foo\xF0\x80\x80\x80bar\n\x80foo\n";
158 open(F,'<:encoding(utf-8)',$threebyte) || die "Cannot open $threebyte:$!";
159 $dstr = join(":", <F>);
161 print "not " unless $dstr eq "foo\\xF0\\x80\\x80\\x80bar\n:\\x80foo\n";
165 1 while unlink($grk, $utf, $fail1, $fail2, $russki, $threebyte);