This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make Encode tests work with $PERL_CORE in the environment
[perl5.git] / ext / Encode / t / CJKT.t
CommitLineData
ef175861 1BEGIN {
ef175861
JH
2 require Config; import Config;
3 if ($Config{'extensions'} !~ /\bEncode\b/) {
4 print "1..0 # Skip: Encode was not built\n";
5 exit 0;
6 }
7 if (ord("A") == 193) {
d1256cb1
RGS
8 print "1..0 # Skip: EBCDIC\n";
9 exit 0;
ef175861 10 }
17ba578b
JH
11# should work w/o PerlIO now!
12# unless (PerlIO::Layer->find('perlio')){
13# print "1..0 # Skip: PerlIO required\n";
14# exit 0;
15# }
ef175861
JH
16 $| = 1;
17}
18use strict;
8676e7d3 19use Test::More tests => 60;
ef175861
JH
20use Encode;
21use File::Basename;
22use File::Spec;
23use File::Compare qw(compare_text);
b7a5c9de 24our $DEBUG = shift || 0;
ef175861
JH
25
26my %Charset =
27 (
8676e7d3 28 'big5-eten' => [qw(big5-eten)],
ef175861 29 'big5-hkscs' => [qw(big5-hkscs)],
8676e7d3
JH
30 gb2312 => [qw(euc-cn hz)],
31 jisx0201 => [qw(euc-jp shiftjis 7bit-jis)],
32 jisx0208 => [qw(euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1)],
33 jisx0212 => [qw(euc-jp 7bit-jis iso-2022-jp-1)],
34 ksc5601 => [qw(euc-kr iso-2022-kr johab)],
ef175861
JH
35 );
36
8676e7d3 37
ef175861 38my $dir = dirname(__FILE__);
b7a5c9de 39my $seq = 1;
ef175861 40
cb3fb9b7 41for my $charset (sort keys %Charset){
ef175861
JH
42 my ($src, $uni, $dst, $txt);
43
44 my $transcoder = find_encoding($Charset{$charset}[0]) or die;
45
46 my $src_enc = File::Spec->catfile($dir,"$charset.enc");
47 my $src_utf = File::Spec->catfile($dir,"$charset.utf");
48 my $dst_enc = File::Spec->catfile($dir,"$$.enc");
49 my $dst_utf = File::Spec->catfile($dir,"$$.utf");
50
ef175861 51 open $src, "<$src_enc" or die "$src_enc : $!";
9735c3fc
JH
52
53 if (PerlIO::Layer->find('perlio')){
d1256cb1 54 binmode($src, ":bytes"); # needed when :utf8 in default open layer
9735c3fc 55 }
7e19fb92 56
ef175861
JH
57 $txt = join('',<$src>);
58 close($src);
59
60 eval{ $uni = $transcoder->decode($txt, 1) };
61 $@ and print $@;
b7a5c9de
JH
62 ok(defined($uni), "decode $charset"); $seq++;
63 is(length($txt),0, "decode $charset completely"); $seq++;
ef175861
JH
64
65 open $dst, ">$dst_utf" or die "$dst_utf : $!";
66 if (PerlIO::Layer->find('perlio')){
d1256cb1
RGS
67 binmode($dst, ":utf8");
68 print $dst $uni;
cb3fb9b7 69 }else{ # ugh!
d1256cb1
RGS
70 binmode($dst);
71 my $raw = $uni; Encode::_utf8_off($raw);
72 print $dst $raw;
ef175861
JH
73 }
74
75 close($dst);
b7a5c9de 76 is(compare_text($dst_utf, $src_utf), 0, "$dst_utf eq $src_utf")
d1256cb1 77 or ($DEBUG and rename $dst_utf, "$dst_utf.$seq");
b7a5c9de 78 $seq++;
ef175861
JH
79
80 open $src, "<$src_utf" or die "$src_utf : $!";
81 if (PerlIO::Layer->find('perlio')){
d1256cb1
RGS
82 binmode($src, ":utf8");
83 $uni = join('', <$src>);
cb3fb9b7 84 }else{ # ugh!
d1256cb1
RGS
85 binmode($src);
86 $uni = join('', <$src>);
87 Encode::_utf8_on($uni);
ef175861
JH
88 }
89 close $src;
90
ab3374e4 91 my $unisave = $uni;
ef175861
JH
92 eval{ $txt = $transcoder->encode($uni,1) };
93 $@ and print $@;
b7a5c9de
JH
94 ok(defined($txt), "encode $charset"); $seq++;
95 is(length($uni), 0, "encode $charset completely"); $seq++;
ab3374e4 96 $uni = $unisave;
ef175861
JH
97
98 open $dst,">$dst_enc" or die "$dst_utf : $!";
99 binmode($dst);
100 print $dst $txt;
101 close($dst);
b7a5c9de 102 is(compare_text($src_enc, $dst_enc), 0 => "$dst_enc eq $src_enc")
d1256cb1 103 or ($DEBUG and rename $dst_enc, "$dst_enc.$seq");
b7a5c9de
JH
104 $seq++;
105
b7a5c9de 106 unlink($dst_utf, $dst_enc);
8676e7d3
JH
107
108 for my $encoding (@{$Charset{$charset}}){
d1256cb1
RGS
109 my $rt = decode($encoding, encode($encoding, $uni));
110 is ($rt, $uni, "RT $encoding");
8676e7d3 111 }
ef175861 112}