Upgrade to Encode 0.97, from Dan Kogai.
[p5sagit/p5-mst-13.2.git] / ext / Encode / t / JP.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 => 27;
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::JP";
28
29 my ($src, $uni, $dst, $txt, $euc, $utf, $ref, $rnd);
30
31 ok(defined(my $enc = find_encoding('euc-jp')));
32 ok($enc->isa('Encode::XS'));
33 is($enc->name,'euc-jp');
34 my $dir = dirname(__FILE__);
35
36 my @subcodings = qw(jisx0212 jisx0208);
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-jp');
78
79 print "# src :encoding test\n";
80 open($src,"<encoding(euc-jp)",$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-jp)",$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-jp');
123
124 END {
125  1 while unlink($utf,$rnd);
126 }