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