ext/Encode/t/JP.t

   1 BEGIN {
   2     chdir 't' if -d 't' and $ENV{PWD} !~ m,/Encode[^/]*$,o;
   3     unshift @INC, '../lib';
   4     require Config; import Config;
   5     if ($Config{'extensions'} !~ /\bEncode\b/) {
   6       print "1..0 # Skip: Encode was not built\n";
   7       exit 0;
   8     }
   9     unless (find PerlIO::Layer 'perlio') {
  10         print "1..0 # Skip: PerlIO was not built\n";
  11         exit 0;
  12     }
  13     if (ord("A") == 193) {
  14         print "1..0 # Skip: EBCDIC\n";
  15         exit 0;
  16     }
  17     $| = 1;
  18 }
  19 use strict;
  20 use Test::More tests => 27;
  21 #use Test::More qw(no_plan);
  22 use Encode;
  23 use File::Basename;
  24 use File::Spec;
  25 use File::Compare;
  26 require_ok "Encode::JP";
  27
  28 my ($src, $uni, $dst, $txt, $euc, $utf, $ref, $rnd);
  29
  30 ok(defined(my $enc = find_encoding('euc-jp')));
  31 ok($enc->isa('Encode::XS'));
  32 is($enc->name,'euc-jp');
  33 my $dir = dirname(__FILE__);
  34
  35 my @subcodings = qw(jisx0212 jisx0208);
  36
  37 for my $subcoding (@subcodings){
  38     $euc = File::Spec->catfile($dir,"$subcoding.euc");
  39     $utf = File::Spec->catfile($dir,"$$.utf8");
  40     $ref = File::Spec->catfile($dir,"$subcoding.ref");
  41     $rnd = File::Spec->catfile($dir,"$$.rnd");
  42     print "# Basic decode test\n";
  43     open($src,"<",$euc) || die "Cannot open $euc:$!";
  44     binmode($src);
  45     ok(defined($src) && fileno($src));
  46     $txt = join('',<$src>);
  47     open($dst,">:utf8",$utf) || die "Cannot open $utf:$!";
  48     binmode($dst);
  49     ok(defined($dst) && fileno($dst));
  50     eval{ $uni = $enc->decode($txt,1) };
  51     $@ and print $@;
  52     ok(defined($uni));
  53     is(length($txt),0);
  54     print $dst $uni;
  55     close($dst);
  56     close($src);
  57     ok(compare($utf,$ref) == 0);
  58 }
  59
  60 print "# Basic encode test\n";
  61 open($src,"<:utf8",$ref) || die "Cannot open $ref:$!";
  62 binmode($src);
  63 ok(defined($src) && fileno($src));
  64 $uni = join('',<$src>);
  65 open($dst,">",$rnd) || die "Cannot open $rnd:$!";
  66 binmode($dst);
  67 ok(defined($dst) && fileno($dst));
  68 $txt = $enc->encode($uni,1);
  69 ok(defined($txt));
  70 is(length($uni),0);
  71 print $dst $txt;
  72 close($dst);
  73 close($src);
  74 ok(compare($euc,$rnd) == 0);
  75
  76 is($enc->name,'euc-jp');
  77
  78 print "# src :encoding test\n";
  79 open($src,"<encoding(euc-jp)",$euc) || die "Cannot open $euc:$!";
  80 binmode($src);
  81 ok(defined($src) && fileno($src));
  82 open($dst,">:utf8",$utf) || die "Cannot open $utf:$!";
  83 binmode($dst);
  84 ok(defined($dst) || fileno($dst));
  85 my $out = select($dst);
  86 while (<$src>)
  87  {
  88   print;
  89  }
  90 close($dst);
  91 close($src);
  92
  93 TODO:
  94 {
  95   local $TODO = 'needs debugging on VMS' if $^O eq 'VMS';
  96   ok(compare($utf,$ref) == 0);
  97 }
  98 select($out);
  99
 100 SKIP:
 101 {
 102  #skip "Multi-byte write is broken",3;
 103  print "# dst :encoding test\n";
 104  open($src,"<:utf8",$ref) || die "Cannot open $ref:$!";
 105  binmode($src);
 106  ok(defined($src) || fileno($src));
 107  open($dst,">encoding(euc-jp)",$rnd) || die "Cannot open $rnd:$!";
 108  binmode($dst);
 109  ok(defined($dst) || fileno($dst));
 110  my $out = select($dst);
 111  while (<$src>)
 112   {
 113    print;
 114   }
 115  close($dst);
 116  close($src);
 117  ok(compare($euc,$rnd) == 0);
 118  select($out);
 119 }
 120
 121 is($enc->name,'euc-jp');
 122
 123 END {
 124  1 while unlink($utf,$rnd);
 125 }