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
CommitLineData
0a95303c 1BEGIN {
f51e7ad5
JH
2 chdir 't' if -d 't';
3 @INC = '../lib';
0a95303c
NIS
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 }
87e4f210
JH
9 unless (find PerlIO::Layer 'perlio') {
10 print "1..0 # Skip: PerlIO was not built\n";
11 exit 0;
12 }
72f0eb71
JH
13 if (ord("A") == 193) {
14 print "1..0 # Skip: EBCDIC\n";
15 exit 0;
16 }
0a95303c
NIS
17 $| = 1;
18}
0e567a6c 19use strict;
0a95303c
NIS
20use Test::More tests => 22;
21use Encode;
22use File::Basename;
23use File::Spec;
24use File::Compare;
0e567a6c
JH
25require_ok "Encode::JP";
26
27my ($src, $uni, $dst, $txt);
0a95303c
NIS
28
29ok(defined(my $enc = find_encoding('euc-jp')));
30ok($enc->isa('Encode::XS'));
31is($enc->name,'euc-jp');
32my $dir = dirname(__FILE__);
33my $euc = File::Spec->catfile($dir,"table.euc");
f51e7ad5 34my $utf = File::Spec->catfile($dir,"$$.utf8");
0a95303c 35my $ref = File::Spec->catfile($dir,"table.ref");
f51e7ad5 36my $rnd = File::Spec->catfile($dir,"$$.rnd");
0a95303c 37print "# Basic decode test\n";
0e567a6c 38open($src,"<",$euc) || die "Cannot open $euc:$!";
0a95303c 39ok(defined($src) && fileno($src));
0e567a6c
JH
40$txt = join('',<$src>);
41open($dst,">:utf8",$utf) || die "Cannot open $utf:$!";
0a95303c 42ok(defined($dst) && fileno($dst));
0e567a6c 43$uni = $enc->decode($txt,1);
0a95303c
NIS
44ok(defined($uni));
45is(length($txt),0);
46print $dst $uni;
47close($dst);
48close($src);
49ok(compare($utf,$ref) == 0);
50
51print "# Basic encode test\n";
0e567a6c 52open($src,"<:utf8",$ref) || die "Cannot open $ref:$!";
0a95303c 53ok(defined($src) && fileno($src));
0e567a6c
JH
54$uni = join('',<$src>);
55open($dst,">",$rnd) || die "Cannot open $rnd:$!";
0a95303c 56ok(defined($dst) && fileno($dst));
0e567a6c 57$txt = $enc->encode($uni,1);
0a95303c
NIS
58ok(defined($txt));
59is(length($uni),0);
60print $dst $txt;
61close($dst);
62close($src);
63ok(compare($euc,$rnd) == 0);
64
65is($enc->name,'euc-jp');
66
67print "# src :encoding test\n";
0e567a6c 68open($src,"<encoding(euc-jp)",$euc) || die "Cannot open $euc:$!";
0a95303c 69ok(defined($src) && fileno($src));
0e567a6c 70open($dst,">:utf8",$utf) || die "Cannot open $utf:$!";
0a95303c 71ok(defined($dst) || fileno($dst));
0e567a6c 72my $out = select($dst);
0a95303c
NIS
73while (<$src>)
74 {
75 print;
76 }
77close($dst);
78close($src);
161720b2
CB
79TODO:
80{
81 local $TODO = 'needs debugging on VMS' if $^O eq 'VMS';
82 ok(compare($utf,$ref) == 0);
83}
0a95303c
NIS
84select($out);
85
86SKIP:
87{
25f7d9d3 88 #skip "Multi-byte write is broken",3;
0a95303c 89 print "# dst :encoding test\n";
0e567a6c 90 open($src,"<:utf8",$ref) || die "Cannot open $ref:$!";
0a95303c 91 ok(defined($src) || fileno($src));
0e567a6c 92 open($dst,">encoding(euc-jp)",$rnd) || die "Cannot open $rnd:$!";
0a95303c
NIS
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
105is($enc->name,'euc-jp');
106END {
f51e7ad5 107 1 while unlink($utf,$rnd);
0a95303c 108}