ext/Encode/t/JP.t

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