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