ext/PerlIO/t/encoding.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
   7     unless (find PerlIO::Layer 'perlio') {
   8         print "1..0 # Skip: not perlio\n";
   9         exit 0;
  10     }
  11 }
  12
  13 print "1..11\n";
  14
  15 my $grk = "grk$$";
  16 my $utf = "utf$$";
  17 my $fail1 = "fail$$";
  18 my $russki = "koi8r$$";
  19
  20 if (open(GRK, ">$grk")) {
  21     binmode(GRK, ":bytes");
  22     # alpha beta gamma in ISO 8859-7
  23     print GRK "\xe1\xe2\xe3";
  24     close GRK or die "Could not close: $!";
  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";
  35     close($o) or die "Could not close: $!";
  36     close($i);
  37 }
  38
  39 if (open(UTF, "<$utf")) {
  40     binmode(UTF, ":bytes");
  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     }
  48     print "ok 4\n";
  49     close UTF;
  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";
  60     close($o) or die "Could not close: $!";
  61     close($i);
  62 }
  63
  64 if (open(GRK, "<$grk")) {
  65     binmode(GRK, ":bytes");
  66     print "not " unless <GRK> eq "\xe1\xe2\xe3";
  67     print "ok 8\n";
  68     close GRK;
  69 }
  70
  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
  86 if (open(RUSSKI, ">$russki")) {
  87     print RUSSKI "\x3c\x3f\x78";
  88     close RUSSKI or die "Could not close: $!";
  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);
  98     if (ord($buf1) == 0x3c &&
  99         ord($buf2) == (ord('A') == 193) ? 0x6f : 0x3f &&
 100         $offset == 2) {
 101         print "ok 11\n";
 102     } else {
 103         printf "not ok 11 # [%s] [%s] %d\n",
 104                join(" ", unpack("H*", $buf1)),
 105                join(" ", unpack("H*", $buf2)), $offset;
 106     }
 107     close(RUSSKI);
 108 } else {
 109     print "not ok 11 # open failed: $!\n";
 110 }
 111
 112 END {
 113     unlink($grk, $utf, $fail1, $russki);
 114 }