Commit | Line | Data |
656753f8 |
1 | BEGIN { |
2 | chdir 't' if -d 't'; |
3 | @INC = '../lib'; |
5a814814 |
4 | require Config; import Config; |
5 | if ($Config{'extensions'} !~ /\Encode\b/) { |
6 | print "1..0 # Skip: Encode was not built\n"; |
7 | exit 0; |
8 | } |
656753f8 |
9 | } |
10 | use Test; |
11 | use Encode qw(from_to); |
12 | use charnames qw(greek); |
13 | my @encodings = grep(/iso8859/,Encode::encodings()); |
14 | my $n = 2; |
f90497d6 |
15 | my @character_set = ('0'..'9', 'A'..'Z', 'a'..'z'); |
16 | my @source = qw(ascii iso8859-1 cp1250); |
17 | my @destiny = qw(cp1047 cp37 posix-bc); |
18 | my @ebcdic_sets = qw(cp1047 cp37 posix-bc); |
19 | plan test => 13+$n*@encodings + 2*@source*@destiny*@character_set + 2*@ebcdic_sets*256; |
656753f8 |
20 | my $str = join('',map(chr($_),0x20..0x7E)); |
21 | my $cpy = $str; |
22 | ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong"); |
23 | ok($cpy,$str,"ASCII mangled by translating from iso8859-1 to Unicode"); |
24 | $cpy = $str; |
25 | ok(from_to($cpy,'Unicode','iso8859-1'),length($str),"Length wrong"); |
26 | ok($cpy,$str,"ASCII mangled by translating from Unicode to iso8859-1"); |
27 | |
28 | $str = join('',map(chr($_),0xa0..0xff)); |
87714904 |
29 | $cpy = $str; |
656753f8 |
30 | ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong"); |
31 | |
32 | my $sym = Encode->getEncoding('symbol'); |
33 | my $uni = $sym->toUnicode('a'); |
f90497d6 |
34 | ok("\N{alpha}",substr($uni,0,1),"alpha does not map to symbol 'a'"); |
656753f8 |
35 | $str = $sym->fromUnicode("\N{Beta}"); |
36 | ok("B",substr($str,0,1),"Symbol 'B' does not map to Beta"); |
37 | |
38 | foreach my $enc (qw(symbol dingbats ascii),@encodings) |
39 | { |
40 | my $tab = Encode->getEncoding($enc); |
41 | ok(1,defined($tab),"Could not load $enc"); |
42 | $str = join('',map(chr($_),0x20..0x7E)); |
43 | $uni = $tab->toUnicode($str); |
44 | $cpy = $tab->fromUnicode($uni); |
45 | ok($cpy,$str,"$enc mangled translating to Unicode and back"); |
46 | } |
47 | |
f90497d6 |
48 | # On ASCII based machines see if we can map several codepoints from |
49 | # three distinct ASCII sets to three distinct EBCDIC coded character sets. |
50 | # On EBCDIC machines see if we can map from three EBCDIC sets to three |
51 | # distinct ASCII sets. |
52 | |
53 | my @expectation = (240..249, 193..201,209..217,226..233, 129..137,145..153,162..169); |
54 | if (ord('A') != 65) { |
55 | my @temp = @destiny; |
56 | @destiny = @source; |
57 | @source = @temp; |
58 | undef(@temp); |
59 | @expectation = (48..57, 65..90, 97..122); |
60 | } |
61 | |
62 | foreach my $to (@destiny) |
63 | { |
64 | foreach my $from (@source) |
65 | { |
66 | my @expected = @expectation; |
67 | foreach my $chr (@character_set) |
68 | { |
69 | my $native_chr = $chr; |
70 | my $cpy = $chr; |
71 | my $rc = from_to($cpy,$from,$to); |
72 | ok(1,$rc,"Could not translate from $from to $to"); |
73 | ok(ord($cpy),shift(@expected),"mangled translating $native_chr from $from to $to"); |
74 | } |
75 | } |
76 | } |
77 | |
78 | # On either ASCII or EBCDIC machines ensure we can take the full one |
79 | # byte repetoire to EBCDIC sets and back. |
80 | |
81 | my $enc_as = 'iso8859-1'; |
82 | foreach my $enc_eb (@ebcdic_sets) |
83 | { |
84 | foreach my $ord (0..255) |
85 | { |
86 | $str = chr($ord); |
87 | my $rc = from_to($str,$enc_as,$enc_eb); |
88 | $rc += from_to($str,$enc_eb,$enc_as); |
89 | ok($rc,2,"return code for $ord $enc_eb -> $enc_as -> $enc_eb was not obtained"); |
90 | ok($ord,ord($str),"$enc_as mangled translating $ord to $enc_eb and back"); |
91 | } |
92 | } |
93 | |