1*0Sstevel@tonic-gateBEGIN { 2*0Sstevel@tonic-gate if ($ENV{'PERL_CORE'}){ 3*0Sstevel@tonic-gate chdir 't'; 4*0Sstevel@tonic-gate unshift @INC, '../lib'; 5*0Sstevel@tonic-gate } 6*0Sstevel@tonic-gate if (ord("A") == 193) { 7*0Sstevel@tonic-gate print "1..0 # Skip: EBCDIC\n"; 8*0Sstevel@tonic-gate exit 0; 9*0Sstevel@tonic-gate } 10*0Sstevel@tonic-gate require Config; import Config; 11*0Sstevel@tonic-gate if ($Config{'extensions'} !~ /\bEncode\b/) { 12*0Sstevel@tonic-gate print "1..0 # Skip: Encode was not built\n"; 13*0Sstevel@tonic-gate exit 0; 14*0Sstevel@tonic-gate } 15*0Sstevel@tonic-gate} 16*0Sstevel@tonic-gateuse strict; 17*0Sstevel@tonic-gateuse Test; 18*0Sstevel@tonic-gateuse Encode qw(from_to encode decode 19*0Sstevel@tonic-gate encode_utf8 decode_utf8 20*0Sstevel@tonic-gate find_encoding is_utf8); 21*0Sstevel@tonic-gateuse charnames qw(greek); 22*0Sstevel@tonic-gatemy @encodings = grep(/iso-?8859/,Encode::encodings()); 23*0Sstevel@tonic-gatemy $n = 2; 24*0Sstevel@tonic-gatemy @character_set = ('0'..'9', 'A'..'Z', 'a'..'z'); 25*0Sstevel@tonic-gatemy @source = qw(ascii iso8859-1 cp1250); 26*0Sstevel@tonic-gatemy @destiny = qw(cp1047 cp37 posix-bc); 27*0Sstevel@tonic-gatemy @ebcdic_sets = qw(cp1047 cp37 posix-bc); 28*0Sstevel@tonic-gateplan test => 38+$n*@encodings + 2*@source*@destiny*@character_set + 2*@ebcdic_sets*256 + 6; 29*0Sstevel@tonic-gatemy $str = join('',map(chr($_),0x20..0x7E)); 30*0Sstevel@tonic-gatemy $cpy = $str; 31*0Sstevel@tonic-gateok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong"); 32*0Sstevel@tonic-gateok($cpy,$str,"ASCII mangled by translating from iso8859-1 to Unicode"); 33*0Sstevel@tonic-gate$cpy = $str; 34*0Sstevel@tonic-gateok(from_to($cpy,'Unicode','iso8859-1'),length($str),"Length wrong"); 35*0Sstevel@tonic-gateok($cpy,$str,"ASCII mangled by translating from Unicode to iso8859-1"); 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gate$str = join('',map(chr($_),0xa0..0xff)); 38*0Sstevel@tonic-gate$cpy = $str; 39*0Sstevel@tonic-gateok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong"); 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gatemy $sym = Encode->getEncoding('symbol'); 42*0Sstevel@tonic-gatemy $uni = $sym->decode(encode(ascii => 'a')); 43*0Sstevel@tonic-gateok("\N{alpha}",substr($uni,0,1),"alpha does not map to symbol 'a'"); 44*0Sstevel@tonic-gate$str = $sym->encode("\N{Beta}"); 45*0Sstevel@tonic-gateok("B",decode(ascii => substr($str,0,1)),"Symbol 'B' does not map to Beta"); 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gateforeach my $enc (qw(symbol dingbats ascii),@encodings) 48*0Sstevel@tonic-gate { 49*0Sstevel@tonic-gate my $tab = Encode->getEncoding($enc); 50*0Sstevel@tonic-gate ok(1,defined($tab),"Could not load $enc"); 51*0Sstevel@tonic-gate $str = join('',map(chr($_),0x20..0x7E)); 52*0Sstevel@tonic-gate $uni = $tab->decode($str); 53*0Sstevel@tonic-gate $cpy = $tab->encode($uni); 54*0Sstevel@tonic-gate ok($cpy,$str,"$enc mangled translating to Unicode and back"); 55*0Sstevel@tonic-gate } 56*0Sstevel@tonic-gate 57*0Sstevel@tonic-gate# On ASCII based machines see if we can map several codepoints from 58*0Sstevel@tonic-gate# three distinct ASCII sets to three distinct EBCDIC coded character sets. 59*0Sstevel@tonic-gate# On EBCDIC machines see if we can map from three EBCDIC sets to three 60*0Sstevel@tonic-gate# distinct ASCII sets. 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gatemy @expectation = (240..249, 193..201,209..217,226..233, 129..137,145..153,162..169); 63*0Sstevel@tonic-gateif (ord('A') != 65) { 64*0Sstevel@tonic-gate my @temp = @destiny; 65*0Sstevel@tonic-gate @destiny = @source; 66*0Sstevel@tonic-gate @source = @temp; 67*0Sstevel@tonic-gate undef(@temp); 68*0Sstevel@tonic-gate @expectation = (48..57, 65..90, 97..122); 69*0Sstevel@tonic-gate} 70*0Sstevel@tonic-gate 71*0Sstevel@tonic-gateforeach my $to (@destiny) 72*0Sstevel@tonic-gate { 73*0Sstevel@tonic-gate foreach my $from (@source) 74*0Sstevel@tonic-gate { 75*0Sstevel@tonic-gate my @expected = @expectation; 76*0Sstevel@tonic-gate foreach my $chr (@character_set) 77*0Sstevel@tonic-gate { 78*0Sstevel@tonic-gate my $native_chr = $chr; 79*0Sstevel@tonic-gate my $cpy = $chr; 80*0Sstevel@tonic-gate my $rc = from_to($cpy,$from,$to); 81*0Sstevel@tonic-gate ok(1,$rc,"Could not translate from $from to $to"); 82*0Sstevel@tonic-gate ok(ord($cpy),shift(@expected),"mangled translating $native_chr from $from to $to"); 83*0Sstevel@tonic-gate } 84*0Sstevel@tonic-gate } 85*0Sstevel@tonic-gate } 86*0Sstevel@tonic-gate 87*0Sstevel@tonic-gate# On either ASCII or EBCDIC machines ensure we can take the full one 88*0Sstevel@tonic-gate# byte repetoire to EBCDIC sets and back. 89*0Sstevel@tonic-gate 90*0Sstevel@tonic-gatemy $enc_as = 'iso8859-1'; 91*0Sstevel@tonic-gateforeach my $enc_eb (@ebcdic_sets) 92*0Sstevel@tonic-gate { 93*0Sstevel@tonic-gate foreach my $ord (0..255) 94*0Sstevel@tonic-gate { 95*0Sstevel@tonic-gate $str = chr($ord); 96*0Sstevel@tonic-gate my $rc = from_to($str,$enc_as,$enc_eb); 97*0Sstevel@tonic-gate $rc += from_to($str,$enc_eb,$enc_as); 98*0Sstevel@tonic-gate ok($rc,2,"return code for $ord $enc_eb -> $enc_as -> $enc_eb was not obtained"); 99*0Sstevel@tonic-gate ok($ord,ord($str),"$enc_as mangled translating $ord to $enc_eb and back"); 100*0Sstevel@tonic-gate } 101*0Sstevel@tonic-gate } 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gatemy $mime = find_encoding('iso-8859-2'); 104*0Sstevel@tonic-gateok(defined($mime),1,"Cannot find MIME-ish'iso-8859-2'"); 105*0Sstevel@tonic-gatemy $x11 = find_encoding('iso8859-2'); 106*0Sstevel@tonic-gateok(defined($x11),1,"Cannot find X11-ish 'iso8859-2'"); 107*0Sstevel@tonic-gateok($mime,$x11,"iso8598-2 and iso-8859-2 not same"); 108*0Sstevel@tonic-gatemy $spc = find_encoding('iso 8859-2'); 109*0Sstevel@tonic-gateok(defined($spc),1,"Cannot find 'iso 8859-2'"); 110*0Sstevel@tonic-gateok($spc,$mime,"iso 8859-2 and iso-8859-2 not same"); 111*0Sstevel@tonic-gate 112*0Sstevel@tonic-gatefor my $i (256,128,129,256) 113*0Sstevel@tonic-gate { 114*0Sstevel@tonic-gate my $c = chr($i); 115*0Sstevel@tonic-gate my $s = "$c\n".sprintf("%02X",$i); 116*0Sstevel@tonic-gate ok(utf8::valid($s),1,"concat of $i botched"); 117*0Sstevel@tonic-gate utf8::upgrade($s); 118*0Sstevel@tonic-gate ok(utf8::valid($s),1,"concat of $i botched"); 119*0Sstevel@tonic-gate } 120*0Sstevel@tonic-gate 121*0Sstevel@tonic-gate# Spot check a few points in/out of utf8 122*0Sstevel@tonic-gatefor my $i (ord('A'),128,256,0x20AC) 123*0Sstevel@tonic-gate { 124*0Sstevel@tonic-gate my $c = chr($i); 125*0Sstevel@tonic-gate my $o = encode_utf8($c); 126*0Sstevel@tonic-gate ok(decode_utf8($o),$c,"decode_utf8 not inverse of encode_utf8 for $i"); 127*0Sstevel@tonic-gate ok(encode('utf8',$c),$o,"utf8 encode by name broken for $i"); 128*0Sstevel@tonic-gate ok(decode('utf8',$o),$c,"utf8 decode by name broken for $i"); 129*0Sstevel@tonic-gate } 130*0Sstevel@tonic-gate 131*0Sstevel@tonic-gate 132*0Sstevel@tonic-gate# is_utf8 133*0Sstevel@tonic-gate 134*0Sstevel@tonic-gateok( is_utf8("\x{100}")); 135*0Sstevel@tonic-gateok(! is_utf8("a")); 136*0Sstevel@tonic-gateok(! is_utf8("")); 137*0Sstevel@tonic-gate"\x{100}" =~ /(.)/; 138*0Sstevel@tonic-gateok( is_utf8($1)); # ID 20011127.151 139*0Sstevel@tonic-gate$a = $1; 140*0Sstevel@tonic-gateok( is_utf8($a)); 141*0Sstevel@tonic-gate$a = "\x{100}"; 142*0Sstevel@tonic-gatechop $a; 143*0Sstevel@tonic-gateok( is_utf8($a)); # weird but true: an empty UTF-8 string 144*0Sstevel@tonic-gate 145