ext/Encode/t/KR.t

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