ext/Encode/t/JP.t

   1 BEGIN {
   2     chdir 't' if -d 't';
   3     @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 => 22;
  21 use Encode;
  22 use File::Basename;
  23 use File::Spec;
  24 use File::Compare;
  25 require_ok "Encode::JP";
  26
  27 my ($src, $uni, $dst, $txt);
  28
  29 ok(defined(my $enc = find_encoding('euc-jp')));
  30 ok($enc->isa('Encode::XS'));
  31 is($enc->name,'euc-jp');
  32 my $dir = dirname(__FILE__);
  33 my $euc = File::Spec->catfile($dir,"table.euc");
  34 my $utf = File::Spec->catfile($dir,"$$.utf8");
  35 my $ref = File::Spec->catfile($dir,"table.ref");
  36 my $rnd = File::Spec->catfile($dir,"$$.rnd");
  37 print "# Basic decode test\n";
  38 open($src,"<",$euc) || die "Cannot open $euc:$!";
  39 binmode($src);
  40 ok(defined($src) && fileno($src));
  41 $txt = join('',<$src>);
  42 open($dst,">:utf8",$utf) || die "Cannot open $utf:$!";
  43 binmode($dst);
  44 ok(defined($dst) && fileno($dst));
  45 $uni = $enc->decode($txt,1);
  46 ok(defined($uni));
  47 is(length($txt),0);
  48 print $dst $uni;
  49 close($dst);
  50 close($src);
  51 ok(compare($utf,$ref) == 0);
  52
  53 print "# Basic encode test\n";
  54 open($src,"<:utf8",$ref) || die "Cannot open $ref:$!";
  55 binmode($src);
  56 ok(defined($src) && fileno($src));
  57 $uni = join('',<$src>);
  58 open($dst,">",$rnd) || die "Cannot open $rnd:$!";
  59 binmode($dst);
  60 ok(defined($dst) && fileno($dst));
  61 $txt = $enc->encode($uni,1);
  62 ok(defined($txt));
  63 is(length($uni),0);
  64 print $dst $txt;
  65 close($dst);
  66 close($src);
  67 ok(compare($euc,$rnd) == 0);
  68
  69 is($enc->name,'euc-jp');
  70
  71 print "# src :encoding test\n";
  72 open($src,"<encoding(euc-jp)",$euc) || die "Cannot open $euc:$!";
  73 binmode($src);
  74 ok(defined($src) && fileno($src));
  75 open($dst,">:utf8",$utf) || die "Cannot open $utf:$!";
  76 binmode($dst);
  77 ok(defined($dst) || fileno($dst));
  78 my $out = select($dst);
  79 while (<$src>)
  80  {
  81   print;
  82  }
  83 close($dst);
  84 close($src);
  85 TODO:
  86 {
  87   local $TODO = 'needs debugging on VMS' if $^O eq 'VMS';
  88   ok(compare($utf,$ref) == 0);
  89 }
  90 select($out);
  91
  92 SKIP:
  93 {
  94  #skip "Multi-byte write is broken",3;
  95  print "# dst :encoding test\n";
  96  open($src,"<:utf8",$ref) || die "Cannot open $ref:$!";
  97  binmode($src);
  98  ok(defined($src) || fileno($src));
  99  open($dst,">encoding(euc-jp)",$rnd) || die "Cannot open $rnd:$!";
 100  binmode($dst);
 101  ok(defined($dst) || fileno($dst));
 102  my $out = select($dst);
 103  while (<$src>)
 104   {
 105    print;
 106   }
 107  close($dst);
 108  close($src);
 109  ok(compare($euc,$rnd) == 0);
 110  select($out);
 111 }
 112
 113 is($enc->name,'euc-jp');
 114 END {
 115  1 while unlink($utf,$rnd);
 116 }