Commit | Line | Data |
af1f55d9 |
1 | BEGIN { |
2 | if ($ENV{'PERL_CORE'}){ |
3 | chdir 't'; |
4 | unshift @INC, '../lib'; |
5 | } |
6 | require Config; import Config; |
7 | if ($Config{'extensions'} !~ /\bEncode\b/) { |
8 | print "1..0 # Skip: Encode was not built\n"; |
9 | exit 0; |
10 | } |
982a4085 |
11 | if (ord("A") == 193) { |
d1256cb1 |
12 | print "1..0 # Skip: EBCDIC\n"; |
13 | exit 0; |
982a4085 |
14 | } |
af1f55d9 |
15 | $| = 1; |
16 | } |
17 | |
18 | use strict; |
19 | use File::Basename; |
20 | use File::Spec; |
21 | use Encode qw(decode encode find_encoding _utf8_off); |
22 | |
23 | #use Test::More qw(no_plan); |
b5ab1f6f |
24 | use Test::More tests => 29; |
af1f55d9 |
25 | use_ok("Encode::Guess"); |
26 | { |
27 | no warnings; |
28 | $Encode::Guess::DEBUG = shift || 0; |
29 | } |
30 | |
31 | my $ascii = join('' => map {chr($_)}(0x21..0x7e)); |
32 | my $latin1 = join('' => map {chr($_)}(0xa1..0xfe)); |
33 | my $utf8on = join('' => map {chr($_)}(0x3000..0x30fe)); |
34 | my $utf8off = $utf8on; _utf8_off($utf8off); |
7e19fb92 |
35 | my $utf16 = encode('UTF-16', $utf8on); |
36 | my $utf32 = encode('UTF-32', $utf8on); |
af1f55d9 |
37 | |
7e19fb92 |
38 | is(guess_encoding($ascii)->name, 'ascii', 'ascii'); |
39 | like(guess_encoding($latin1), qr/No appropriate encoding/io, 'no ascii'); |
40 | is(guess_encoding($latin1, 'latin1')->name, 'iso-8859-1', 'iso-8859-1'); |
41 | is(guess_encoding($utf8on)->name, 'utf8', 'utf8 w/ flag'); |
42 | is(guess_encoding($utf8off)->name, 'utf8', 'utf8 w/o flag'); |
43 | is(guess_encoding($utf16)->name, 'UTF-16', 'UTF-16'); |
44 | is(guess_encoding($utf32)->name, 'UTF-32', 'UTF-32'); |
af1f55d9 |
45 | |
46 | my $jisx0201 = File::Spec->catfile(dirname(__FILE__), 'jisx0201.utf'); |
47 | my $jisx0208 = File::Spec->catfile(dirname(__FILE__), 'jisx0208.utf'); |
48 | my $jisx0212 = File::Spec->catfile(dirname(__FILE__), 'jisx0212.utf'); |
49 | |
50 | open my $fh, $jisx0208 or die "$jisx0208: $!"; |
cb3fb9b7 |
51 | binmode($fh); |
af1f55d9 |
52 | $utf8off = join('' => <$fh>); |
53 | close $fh; |
54 | $utf8on = decode('utf8', $utf8off); |
7e19fb92 |
55 | |
af1f55d9 |
56 | my @jp = qw(7bit-jis shiftjis euc-jp); |
57 | |
7e19fb92 |
58 | Encode::Guess->set_suspects(@jp); |
af1f55d9 |
59 | |
60 | for my $jp (@jp){ |
61 | my $test = encode($jp, $utf8on); |
7e19fb92 |
62 | is(guess_encoding($test)->name, $jp, "JP:$jp"); |
af1f55d9 |
63 | } |
7e19fb92 |
64 | |
af1f55d9 |
65 | is (decode('Guess', encode('euc-jp', $utf8on)), $utf8on, "decode('Guess')"); |
66 | eval{ encode('Guess', $utf8on) }; |
10c5ecbb |
67 | like($@, qr/not defined/io, "no encode()"); |
7e19fb92 |
68 | |
69 | my %CJKT = |
70 | ( |
71 | 'euc-cn' => File::Spec->catfile(dirname(__FILE__), 'gb2312.utf'), |
72 | 'euc-jp' => File::Spec->catfile(dirname(__FILE__), 'jisx0208.utf'), |
73 | 'euc-kr' => File::Spec->catfile(dirname(__FILE__), 'ksc5601.utf'), |
74 | 'big5-eten' => File::Spec->catfile(dirname(__FILE__), 'big5-eten.utf'), |
75 | ); |
76 | |
77 | Encode::Guess->set_suspects(keys %CJKT); |
78 | |
79 | for my $name (keys %CJKT){ |
80 | open my $fh, $CJKT{$name} or die "$CJKT{$name}: $!"; |
cb3fb9b7 |
81 | binmode($fh); |
7e19fb92 |
82 | $utf8off = join('' => <$fh>); |
83 | close $fh; |
84 | |
85 | my $test = encode($name, decode('utf8', $utf8off)); |
86 | is(guess_encoding($test)->name, $name, "CJKT:$name"); |
87 | } |
88 | |
8676e7d3 |
89 | my $ambiguous = "\x{5c0f}\x{98fc}\x{5f3e}"; |
90 | my $english = "The quick brown fox jumps over the black lazy dog."; |
91 | for my $utf (qw/UTF-16 UTF-32/){ |
92 | for my $bl (qw/BE LE/){ |
d1256cb1 |
93 | my $test = encode("$utf$bl" => $english); |
94 | is(guess_encoding($test)->name, "$utf$bl", "$utf$bl"); |
8676e7d3 |
95 | } |
96 | } |
97 | for my $bl (qw/BE LE/){ |
98 | my $test = encode("UTF-16$bl" => $ambiguous); |
99 | my $result = guess_encoding($test); |
100 | ok(! ref($result), "UTF-16$bl:$result"); |
101 | } |
b5ab1f6f |
102 | |
103 | |
104 | |
105 | Encode::Guess->set_suspects(); |
106 | for my $jp (@jp){ |
107 | # intentionally set $1 a priori -- see Changes |
108 | my $test = "English"; |
109 | '$1' =~ m/^(.*)/o; |
110 | is(guess_encoding($test, ($jp))->name, 'ascii', |
111 | "ascii vs $jp (\$1 messed)"); |
112 | $test = encode($jp, $test . "\n\x{65e5}\x{672c}\x{8a9e}"); |
113 | is(guess_encoding($test, ($jp))->name, |
114 | $jp, "$jp vs ascii (\$1 messed)"); |
115 | } |
116 | |
af1f55d9 |
117 | __END__; |