1*0Sstevel@tonic-gate#!./perl -w 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate no warnings; # Need global -w flag for later tests, but don't want this 7*0Sstevel@tonic-gate # to warn here: 8*0Sstevel@tonic-gate push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; 9*0Sstevel@tonic-gate unless (find PerlIO::Layer 'perlio') { 10*0Sstevel@tonic-gate print "1..0 # Skip: not perlio\n"; 11*0Sstevel@tonic-gate exit 0; 12*0Sstevel@tonic-gate } 13*0Sstevel@tonic-gate unless (eval { require Encode } ) { 14*0Sstevel@tonic-gate print "1..0 # Skip: not Encode\n"; 15*0Sstevel@tonic-gate exit 0; 16*0Sstevel@tonic-gate } 17*0Sstevel@tonic-gate} 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gateprint "1..14\n"; 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gatemy $grk = "grk$$"; 22*0Sstevel@tonic-gatemy $utf = "utf$$"; 23*0Sstevel@tonic-gatemy $fail1 = "fa$$"; 24*0Sstevel@tonic-gatemy $fail2 = "fb$$"; 25*0Sstevel@tonic-gatemy $russki = "koi8r$$"; 26*0Sstevel@tonic-gatemy $threebyte = "3byte$$"; 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gateif (open(GRK, ">$grk")) { 29*0Sstevel@tonic-gate binmode(GRK, ":bytes"); 30*0Sstevel@tonic-gate # alpha beta gamma in ISO 8859-7 31*0Sstevel@tonic-gate print GRK "\xe1\xe2\xe3"; 32*0Sstevel@tonic-gate close GRK or die "Could not close: $!"; 33*0Sstevel@tonic-gate} 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gate{ 36*0Sstevel@tonic-gate open(my $i,'<:encoding(iso-8859-7)',$grk); 37*0Sstevel@tonic-gate print "ok 1\n"; 38*0Sstevel@tonic-gate open(my $o,'>:utf8',$utf); 39*0Sstevel@tonic-gate print "ok 2\n"; 40*0Sstevel@tonic-gate print $o readline($i); 41*0Sstevel@tonic-gate print "ok 3\n"; 42*0Sstevel@tonic-gate close($o) or die "Could not close: $!"; 43*0Sstevel@tonic-gate close($i); 44*0Sstevel@tonic-gate} 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gateif (open(UTF, "<$utf")) { 47*0Sstevel@tonic-gate binmode(UTF, ":bytes"); 48*0Sstevel@tonic-gate if (ord('A') == 193) { # EBCDIC 49*0Sstevel@tonic-gate # alpha beta gamma in UTF-EBCDIC Unicode (0x3b1 0x3b2 0x3b3) 50*0Sstevel@tonic-gate print "not " unless <UTF> eq "\xb4\x58\xb4\x59\xb4\x62"; 51*0Sstevel@tonic-gate } else { 52*0Sstevel@tonic-gate # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3) 53*0Sstevel@tonic-gate print "not " unless <UTF> eq "\xce\xb1\xce\xb2\xce\xb3"; 54*0Sstevel@tonic-gate } 55*0Sstevel@tonic-gate print "ok 4\n"; 56*0Sstevel@tonic-gate close UTF; 57*0Sstevel@tonic-gate} 58*0Sstevel@tonic-gate 59*0Sstevel@tonic-gate{ 60*0Sstevel@tonic-gate use Encode; 61*0Sstevel@tonic-gate open(my $i,'<:utf8',$utf); 62*0Sstevel@tonic-gate print "ok 5\n"; 63*0Sstevel@tonic-gate open(my $o,'>:encoding(iso-8859-7)',$grk); 64*0Sstevel@tonic-gate print "ok 6\n"; 65*0Sstevel@tonic-gate print $o readline($i); 66*0Sstevel@tonic-gate print "ok 7\n"; 67*0Sstevel@tonic-gate close($o) or die "Could not close: $!"; 68*0Sstevel@tonic-gate close($i); 69*0Sstevel@tonic-gate} 70*0Sstevel@tonic-gate 71*0Sstevel@tonic-gateif (open(GRK, "<$grk")) { 72*0Sstevel@tonic-gate binmode(GRK, ":bytes"); 73*0Sstevel@tonic-gate print "not " unless <GRK> eq "\xe1\xe2\xe3"; 74*0Sstevel@tonic-gate print "ok 8\n"; 75*0Sstevel@tonic-gate close GRK; 76*0Sstevel@tonic-gate} 77*0Sstevel@tonic-gate 78*0Sstevel@tonic-gate$SIG{__WARN__} = sub {$warn .= $_[0]}; 79*0Sstevel@tonic-gate 80*0Sstevel@tonic-gateif (open(FAIL, ">:encoding(NoneSuch)", $fail1)) { 81*0Sstevel@tonic-gate print "not ok 9 # Open should fail\n"; 82*0Sstevel@tonic-gate} else { 83*0Sstevel@tonic-gate print "ok 9\n"; 84*0Sstevel@tonic-gate} 85*0Sstevel@tonic-gateif (!defined $warn) { 86*0Sstevel@tonic-gate print "not ok 10 # warning is undef\n"; 87*0Sstevel@tonic-gate} elsif ($warn =~ /^Cannot find encoding "NoneSuch" at/) { 88*0Sstevel@tonic-gate print "ok 10\n"; 89*0Sstevel@tonic-gate} else { 90*0Sstevel@tonic-gate print "not ok 10 # warning is '$warn'"; 91*0Sstevel@tonic-gate} 92*0Sstevel@tonic-gate 93*0Sstevel@tonic-gateif (open(RUSSKI, ">$russki")) { 94*0Sstevel@tonic-gate print RUSSKI "\x3c\x3f\x78"; 95*0Sstevel@tonic-gate close RUSSKI or die "Could not close: $!"; 96*0Sstevel@tonic-gate open(RUSSKI, "$russki"); 97*0Sstevel@tonic-gate binmode(RUSSKI, ":raw"); 98*0Sstevel@tonic-gate my $buf1; 99*0Sstevel@tonic-gate read(RUSSKI, $buf1, 1); 100*0Sstevel@tonic-gate # eof(RUSSKI); 101*0Sstevel@tonic-gate binmode(RUSSKI, ":encoding(koi8-r)"); 102*0Sstevel@tonic-gate my $buf2; 103*0Sstevel@tonic-gate read(RUSSKI, $buf2, 1); 104*0Sstevel@tonic-gate my $offset = tell(RUSSKI); 105*0Sstevel@tonic-gate if (ord($buf1) == 0x3c && 106*0Sstevel@tonic-gate ord($buf2) == (ord('A') == 193) ? 0x6f : 0x3f && 107*0Sstevel@tonic-gate $offset == 2) { 108*0Sstevel@tonic-gate print "ok 11\n"; 109*0Sstevel@tonic-gate } else { 110*0Sstevel@tonic-gate printf "not ok 11 # [%s] [%s] %d\n", 111*0Sstevel@tonic-gate join(" ", unpack("H*", $buf1)), 112*0Sstevel@tonic-gate join(" ", unpack("H*", $buf2)), $offset; 113*0Sstevel@tonic-gate } 114*0Sstevel@tonic-gate close(RUSSKI); 115*0Sstevel@tonic-gate} else { 116*0Sstevel@tonic-gate print "not ok 11 # open failed: $!\n"; 117*0Sstevel@tonic-gate} 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gateundef $warn; 120*0Sstevel@tonic-gate 121*0Sstevel@tonic-gate# Check there is no Use of uninitialized value in concatenation (.) warning 122*0Sstevel@tonic-gate# due to the way @latin2iso_num was used to make aliases. 123*0Sstevel@tonic-gateif (open(FAIL, ">:encoding(latin42)", $fail2)) { 124*0Sstevel@tonic-gate print "not ok 12 # Open should fail\n"; 125*0Sstevel@tonic-gate} else { 126*0Sstevel@tonic-gate print "ok 12\n"; 127*0Sstevel@tonic-gate} 128*0Sstevel@tonic-gateif (!defined $warn) { 129*0Sstevel@tonic-gate print "not ok 13 # warning is undef\n"; 130*0Sstevel@tonic-gate} elsif ($warn =~ /^Cannot find encoding "latin42" at.*line \d+\.$/) { 131*0Sstevel@tonic-gate print "ok 13\n"; 132*0Sstevel@tonic-gate} else { 133*0Sstevel@tonic-gate print "not ok 13 # warning is: \n"; 134*0Sstevel@tonic-gate $warn =~ s/^/# /mg; 135*0Sstevel@tonic-gate print "$warn"; 136*0Sstevel@tonic-gate} 137*0Sstevel@tonic-gate 138*0Sstevel@tonic-gate# Create a string of chars that are 3 bytes in UTF-8 139*0Sstevel@tonic-gatemy $str = "\x{1f80}" x 2048; 140*0Sstevel@tonic-gate 141*0Sstevel@tonic-gate# Write them to a file 142*0Sstevel@tonic-gateopen(F,'>:utf8',$threebyte) || die "Cannot open $threebyte:$!"; 143*0Sstevel@tonic-gateprint F $str; 144*0Sstevel@tonic-gateclose(F); 145*0Sstevel@tonic-gate 146*0Sstevel@tonic-gate# Read file back as UTF-8 147*0Sstevel@tonic-gateopen(F,'<:encoding(utf-8)',$threebyte) || die "Cannot open $threebyte:$!"; 148*0Sstevel@tonic-gatemy $dstr = <F>; 149*0Sstevel@tonic-gateclose(F); 150*0Sstevel@tonic-gateprint "not " unless ($dstr eq $str); 151*0Sstevel@tonic-gateprint "ok 14\n"; 152*0Sstevel@tonic-gate 153*0Sstevel@tonic-gateEND { 154*0Sstevel@tonic-gate 1 while unlink($grk, $utf, $fail1, $fail2, $russki, $threebyte); 155*0Sstevel@tonic-gate} 156