Skip the RV printing test under threads until fixed.
[p5sagit/p5-mst-13.2.git] / ext / Encode.t
CommitLineData
656753f8 1BEGIN {
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}
10use Test;
51ef4e11 11use Encode qw(from_to encode decode encode_utf8 decode_utf8 find_encoding);
656753f8 12use charnames qw(greek);
51ef4e11 13my @encodings = grep(/iso-?8859/,Encode::encodings());
656753f8 14my $n = 2;
f90497d6 15my @character_set = ('0'..'9', 'A'..'Z', 'a'..'z');
16my @source = qw(ascii iso8859-1 cp1250);
17my @destiny = qw(cp1047 cp37 posix-bc);
18my @ebcdic_sets = qw(cp1047 cp37 posix-bc);
51ef4e11 19plan test => 38+$n*@encodings + 2*@source*@destiny*@character_set + 2*@ebcdic_sets*256;
656753f8 20my $str = join('',map(chr($_),0x20..0x7E));
21my $cpy = $str;
22ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong");
23ok($cpy,$str,"ASCII mangled by translating from iso8859-1 to Unicode");
24$cpy = $str;
25ok(from_to($cpy,'Unicode','iso8859-1'),length($str),"Length wrong");
26ok($cpy,$str,"ASCII mangled by translating from Unicode to iso8859-1");
27
28$str = join('',map(chr($_),0xa0..0xff));
87714904 29$cpy = $str;
656753f8 30ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong");
31
32my $sym = Encode->getEncoding('symbol');
7d85a32c 33my $uni = $sym->decode(encode(ascii => 'a'));
f90497d6 34ok("\N{alpha}",substr($uni,0,1),"alpha does not map to symbol 'a'");
50d26985 35$str = $sym->encode("\N{Beta}");
7d85a32c 36ok("B",decode(ascii => substr($str,0,1)),"Symbol 'B' does not map to Beta");
656753f8 37
38foreach 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));
50d26985 43 $uni = $tab->decode($str);
44 $cpy = $tab->encode($uni);
656753f8 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.
a12c0f56 50# On EBCDIC machines see if we can map from three EBCDIC sets to three
f90497d6 51# distinct ASCII sets.
52
53my @expectation = (240..249, 193..201,209..217,226..233, 129..137,145..153,162..169);
54if (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
62foreach 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
81my $enc_as = 'iso8859-1';
82foreach 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
51ef4e11 94my $mime = find_encoding('iso-8859-2');
95ok(defined($mime),1,"Cannot find MIME-ish'iso-8859-2'");
96my $x11 = find_encoding('iso8859-2');
97ok(defined($x11),1,"Cannot find X11-ish 'iso8859-2'");
98ok($mime,$x11,"iso8598-2 and iso-8859-2 not same");
99my $spc = find_encoding('iso 8859-2');
100ok(defined($spc),1,"Cannot find 'iso 8859-2'");
101ok($spc,$mime,"iso 8859-2 and iso-8859-2 not same");
102
4411f3b6 103for my $i (256,128,129,256)
a12c0f56 104 {
105 my $c = chr($i);
106 my $s = "$c\n".sprintf("%02X",$i);
1b026014 107 ok(utf8::valid($s),1,"concat of $i botched");
108 utf8::upgrade($s);
109 ok(utf8::valid($s),1,"concat of $i botched");
a12c0f56 110 }
111
4411f3b6 112# Spot check a few points in/out of utf8
113for my $i (0x41,128,256,0x20AC)
114 {
115 my $c = chr($i);
116 my $o = encode_utf8($c);
117 ok(decode_utf8($o),$c,"decode_utf8 not inverse of encode_utf8 for $i");
118 ok(encode('utf8',$c),$o,"utf8 encode by name broken for $i");
119 ok(decode('utf8',$o),$c,"utf8 decode by name broken for $i");
120 }
121
122