This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
VMS test and perldelta update
[perl5.git] / 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 ok(defined($src) && fileno($src));
40 $txt = join('',<$src>);
41 open($dst,">:utf8",$utf) || die "Cannot open $utf:$!";
42 ok(defined($dst) && fileno($dst));
43 $uni = $enc->decode($txt,1);
44 ok(defined($uni));
45 is(length($txt),0);
46 print $dst $uni;
47 close($dst);
48 close($src);
49 ok(compare($utf,$ref) == 0);
50
51 print "# Basic encode test\n";
52 open($src,"<:utf8",$ref) || die "Cannot open $ref:$!";
53 ok(defined($src) && fileno($src));
54 $uni = join('',<$src>);
55 open($dst,">",$rnd) || die "Cannot open $rnd:$!";
56 ok(defined($dst) && fileno($dst));
57 $txt = $enc->encode($uni,1);
58 ok(defined($txt));
59 is(length($uni),0);
60 print $dst $txt;
61 close($dst);
62 close($src);
63 ok(compare($euc,$rnd) == 0);
64
65 is($enc->name,'euc-jp');
66
67 print "# src :encoding test\n";
68 open($src,"<encoding(euc-jp)",$euc) || die "Cannot open $euc:$!";
69 ok(defined($src) && fileno($src));
70 open($dst,">:utf8",$utf) || die "Cannot open $utf:$!";
71 ok(defined($dst) || fileno($dst));
72 my $out = select($dst);
73 while (<$src>)
74  {
75   print;
76  }
77 close($dst);
78 close($src);
79 TODO:
80 {
81   local $TODO = 'needs debugging on VMS' if $^O eq 'VMS';
82   ok(compare($utf,$ref) == 0);
83 }
84 select($out);
85
86 SKIP:
87 {
88  #skip "Multi-byte write is broken",3;
89  print "# dst :encoding test\n";
90  open($src,"<:utf8",$ref) || die "Cannot open $ref:$!";
91  ok(defined($src) || fileno($src));
92  open($dst,">encoding(euc-jp)",$rnd) || die "Cannot open $rnd:$!";
93  ok(defined($dst) || fileno($dst));
94  my $out = select($dst);
95  while (<$src>)
96   {
97    print;
98   }
99  close($dst);
100  close($src);
101  ok(compare($euc,$rnd) == 0);
102  select($out);
103 }
104
105 is($enc->name,'euc-jp');
106 END {
107  1 while unlink($utf,$rnd);
108 }