ext/PerlIO/t/encoding.t

   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
  12 print "1..11\n";
  13
  14 my $grk = "grk$$";
  15 my $utf = "utf$$";
  16 my $fail1 = "fail$$";
  17 my $russki = "koi8r$$";
  18
  19 if (open(GRK, ">$grk")) {
  20     binmode(GRK, ":bytes");
  21     # alpha beta gamma in ISO 8859-7
  22     print GRK "\xe1\xe2\xe3";
  23     close GRK or die "Could not close: $!";
  24 }
  25
  26 {
  27     use Encode;
  28     open(my $i,'<:encoding(iso-8859-7)',$grk);
  29     print "ok 1\n";
  30     open(my $o,'>:utf8',$utf);
  31     print "ok 2\n";
  32     print $o readline($i);
  33     print "ok 3\n";
  34     close($o) or die "Could not close: $!";
  35     close($i);
  36 }
  37
  38 if (open(UTF, "<$utf")) {
  39     binmode(UTF, ":bytes");
  40     if (ord('A') == 193) { # EBCDIC
  41         # alpha beta gamma in UTF-EBCDIC Unicode (0x3b1 0x3b2 0x3b3)
  42         print "not " unless <UTF> eq "\xb4\x58\xb4\x59\xb4\x62";
  43     } else {
  44         # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3)
  45         print "not " unless <UTF> eq "\xce\xb1\xce\xb2\xce\xb3";
  46     }
  47     print "ok 4\n";
  48     close UTF;
  49 }
  50
  51 {
  52     use Encode;
  53     open(my $i,'<:utf8',$utf);
  54     print "ok 5\n";
  55     open(my $o,'>:encoding(iso-8859-7)',$grk);
  56     print "ok 6\n";
  57     print $o readline($i);
  58     print "ok 7\n";
  59     close($o) or die "Could not close: $!";
  60     close($i);
  61 }
  62
  63 if (open(GRK, "<$grk")) {
  64     binmode(GRK, ":bytes");
  65     print "not " unless <GRK> eq "\xe1\xe2\xe3";
  66     print "ok 8\n";
  67     close GRK;
  68 }
  69
  70 $SIG{__WARN__} = sub {$warn = $_[0]};
  71
  72 if (open(FAIL, ">:encoding(NoneSuch)", $fail1)) {
  73     print "not ok 9 # Open should fail\n";
  74 } else {
  75     print "ok 9\n";
  76 }
  77 if (!defined $warn) {
  78     print "not ok 10 # warning is undef\n";
  79 } elsif ($warn =~ /^Cannot find encoding "NoneSuch" at/) {
  80     print "ok 10\n";
  81 } else {
  82     print "not ok 10 # warning is '$warn'";
  83 }
  84
  85 if (open(RUSSKI, ">$russki")) {
  86     print RUSSKI "\x3c\x3f\x78";
  87     close RUSSKI or die "Could not close: $!";
  88     open(RUSSKI, "$russki");
  89     binmode(RUSSKI, ":raw");
  90     my $buf1;
  91     read(RUSSKI, $buf1, 1);
  92     eof(RUSSKI);
  93     binmode(RUSSKI, ":encoding(koi8-r)");
  94     my $buf2;
  95     read(RUSSKI, $buf2, 1);
  96     my $offset = tell(RUSSKI);
  97     if (ord($buf1) == 0x3c &&
  98         ord($buf2) == (ord('A') == 193) ? 0x6f : 0x3f &&
  99         $offset == 2) {
 100         print "ok 11\n";
 101     } else {
 102         printf "not ok 11 # [%s] [%s] %d\n",
 103                join(" ", unpack("H*", $buf1)),
 104                join(" ", unpack("H*", $buf2)), $offset;
 105     }
 106     close(RUSSKI);
 107 } else {
 108     print "not ok 11 # open failed: $!\n";
 109 }
 110
 111 END {
 112     unlink($grk, $utf, $fail1, $russki);
 113 }