Commit | Line | Data |
---|---|---|
ef175861 | 1 | BEGIN { |
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 | } | |
18 | use strict; | |
8676e7d3 | 19 | use Test::More tests => 60; |
ef175861 JH |
20 | use Encode; |
21 | use File::Basename; | |
22 | use File::Spec; | |
23 | use File::Compare qw(compare_text); | |
b7a5c9de | 24 | our $DEBUG = shift || 0; |
ef175861 JH |
25 | |
26 | my %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 | 38 | my $dir = dirname(__FILE__); |
b7a5c9de | 39 | my $seq = 1; |
ef175861 | 40 | |
cb3fb9b7 | 41 | for 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 | } |