This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Errno slightly to latest version
[perl5.git] / ext / Encode / t / guess.t
CommitLineData
af1f55d9
JH
1BEGIN {
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 }
62822184
CN
11 if (ord("A") == 193) {
12 print "1..0 # Skip: EBCDIC\n";
13 exit 0;
14 }
af1f55d9
JH
15 $| = 1;
16}
17
18use strict;
19use File::Basename;
20use File::Spec;
21use Encode qw(decode encode find_encoding _utf8_off);
22
23#use Test::More qw(no_plan);
7e19fb92 24use Test::More tests => 17;
af1f55d9
JH
25use_ok("Encode::Guess");
26{
27 no warnings;
28 $Encode::Guess::DEBUG = shift || 0;
29}
30
31my $ascii = join('' => map {chr($_)}(0x21..0x7e));
32my $latin1 = join('' => map {chr($_)}(0xa1..0xfe));
33my $utf8on = join('' => map {chr($_)}(0x3000..0x30fe));
34my $utf8off = $utf8on; _utf8_off($utf8off);
7e19fb92
JH
35my $utf16 = encode('UTF-16', $utf8on);
36my $utf32 = encode('UTF-32', $utf8on);
af1f55d9 37
7e19fb92
JH
38is(guess_encoding($ascii)->name, 'ascii', 'ascii');
39like(guess_encoding($latin1), qr/No appropriate encoding/io, 'no ascii');
40is(guess_encoding($latin1, 'latin1')->name, 'iso-8859-1', 'iso-8859-1');
41is(guess_encoding($utf8on)->name, 'utf8', 'utf8 w/ flag');
42is(guess_encoding($utf8off)->name, 'utf8', 'utf8 w/o flag');
43is(guess_encoding($utf16)->name, 'UTF-16', 'UTF-16');
44is(guess_encoding($utf32)->name, 'UTF-32', 'UTF-32');
af1f55d9
JH
45
46my $jisx0201 = File::Spec->catfile(dirname(__FILE__), 'jisx0201.utf');
47my $jisx0208 = File::Spec->catfile(dirname(__FILE__), 'jisx0208.utf');
48my $jisx0212 = File::Spec->catfile(dirname(__FILE__), 'jisx0212.utf');
49
50open my $fh, $jisx0208 or die "$jisx0208: $!";
51$utf8off = join('' => <$fh>);
52close $fh;
53$utf8on = decode('utf8', $utf8off);
7e19fb92 54
af1f55d9
JH
55my @jp = qw(7bit-jis shiftjis euc-jp);
56
7e19fb92 57Encode::Guess->set_suspects(@jp);
af1f55d9
JH
58
59for my $jp (@jp){
60 my $test = encode($jp, $utf8on);
7e19fb92 61 is(guess_encoding($test)->name, $jp, "JP:$jp");
af1f55d9 62}
7e19fb92 63
af1f55d9
JH
64is (decode('Guess', encode('euc-jp', $utf8on)), $utf8on, "decode('Guess')");
65eval{ encode('Guess', $utf8on) };
10c5ecbb 66like($@, qr/not defined/io, "no encode()");
7e19fb92
JH
67
68my %CJKT =
69 (
70 'euc-cn' => File::Spec->catfile(dirname(__FILE__), 'gb2312.utf'),
71 'euc-jp' => File::Spec->catfile(dirname(__FILE__), 'jisx0208.utf'),
72 'euc-kr' => File::Spec->catfile(dirname(__FILE__), 'ksc5601.utf'),
73 'big5-eten' => File::Spec->catfile(dirname(__FILE__), 'big5-eten.utf'),
74);
75
76Encode::Guess->set_suspects(keys %CJKT);
77
78for my $name (keys %CJKT){
79 open my $fh, $CJKT{$name} or die "$CJKT{$name}: $!";
80 $utf8off = join('' => <$fh>);
81 close $fh;
82
83 my $test = encode($name, decode('utf8', $utf8off));
84 is(guess_encoding($test)->name, $name, "CJKT:$name");
85}
86
af1f55d9 87__END__;