1# $Id: enc_eucjp.t,v 2.6 2019/01/31 04:26:40 dankogai Exp $ 2# This is the twin of enc_utf8.t . 3 4BEGIN { 5 require Config; import Config; 6 if ($Config{'extensions'} !~ /\bEncode\b/) { 7 print "1..0 # Skip: Encode was not built\n"; 8 exit 0; 9 } 10 unless (find PerlIO::Layer 'perlio') { 11 print "1..0 # Skip: PerlIO was not built\n"; 12 exit 0; 13 } 14 if (ord("A") == 193) { 15 print "1..0 # encoding pragma does not support EBCDIC platforms\n"; 16 exit(0); 17 } 18 if ($] <= 5.008 and !$Config{perl_patchlevel}){ 19 print "1..0 # Skip: Perl 5.8.1 or later required\n"; 20 exit 0; 21 } 22 if ($] >= 5.025003 and !$Config{usecperl}){ 23 print "1..0 # Skip: Perl <=5.25.2 or cperl required\n"; 24 exit 0; 25 } 26} 27 28use Encode qw(); 29$PerlIO::encoding::fallback |= Encode::ONLY_PRAGMA_WARNINGS; 30use warnings "utf8"; 31 32no warnings "deprecated"; 33use encoding 'euc-jp'; 34 35my @c = (127, 128, 255, 256); 36 37print "1.." . (scalar @c + 2) . "\n"; 38 39my @f; 40 41for my $i (0..$#c) { 42 no warnings 'pack'; 43 my $file = filename("f$i"); 44 push @f, $file; 45 open(F, ">$file") or die "$0: failed to open '$file' for writing: $!"; 46 binmode(F, ":utf8"); 47 print F chr($c[$i]); 48 print F pack("C" => $c[$i]); 49 close F; 50} 51 52my $t = 1; 53 54for my $i (0..$#c) { 55 my $file = filename("f$i"); 56 open(F, "<$file") or die "$0: failed to open '$file' for reading: $!"; 57 binmode(F, ":utf8"); 58 my $c = <F>; 59 my $o = ord($c); 60 print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$i]: $o != $c[$i]\n"; 61 $t++; 62} 63 64my $f = filename("f" . @f); 65 66push @f, $f; 67open(F, ">$f") or die "$0: failed to open '$f' for writing: $!"; 68binmode(F, ":raw"); # Output raw bytes. 69print F chr(128); # Output illegal UTF-8. 70close F; 71open(F, $f) or die "$0: failed to open '$f' for reading: $!"; 72binmode(F, ":encoding(UTF-8)"); 73{ 74 local $^W = 1; 75 local $SIG{__WARN__} = sub { $a = shift }; 76 eval { <F> }; # This should get caught. 77} 78close F; 79print $a =~ qr{^UTF-8 "\\x80" does not map to Unicode} ? 80 "ok $t - illegal UTF-8 input\n" : "not ok $t - illegal UTF-8 input: a = " . unpack("H*", $a) . "\n"; 81$t++; 82 83open(F, $f) or die "$0: failed to open '$f' for reading: $!"; 84binmode(F, ":encoding(utf8)"); 85{ 86 local $^W = 1; 87 local $SIG{__WARN__} = sub { $a = shift }; 88 eval { <F> }; # This should get caught. 89} 90close F; 91print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ? 92 "ok $t - illegal utf8 input\n" : "not ok $t - illegal utf8 input: a = " . unpack("H*", $a) . "\n"; 93$t++; 94 95# On VMS temporary file names like "f0." may be more readable than "f0" since 96# "f0" could be a logical name pointing elsewhere. 97sub filename { 98 my $name = shift; 99 $name .= '.' if $^O eq 'VMS'; 100 return $name; 101} 102 103END { 104 1 while unlink @f; 105} 106