1*0Sstevel@tonic-gate# 2*0Sstevel@tonic-gate# $Id: Unicode.t,v 1.13 2003/06/18 09:29:02 dankogai Exp $ 3*0Sstevel@tonic-gate# 4*0Sstevel@tonic-gate# This script is written entirely in ASCII, even though quoted literals 5*0Sstevel@tonic-gate# do include non-BMP unicode characters -- Are you happy, jhi? 6*0Sstevel@tonic-gate# 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gateBEGIN { 9*0Sstevel@tonic-gate require Config; import Config; 10*0Sstevel@tonic-gate if ($Config{'extensions'} !~ /\bEncode\b/) { 11*0Sstevel@tonic-gate print "1..0 # Skip: Encode was not built\n"; 12*0Sstevel@tonic-gate exit 0; 13*0Sstevel@tonic-gate } 14*0Sstevel@tonic-gate if (ord("A") == 193) { 15*0Sstevel@tonic-gate print "1..0 # Skip: EBCDIC\n"; 16*0Sstevel@tonic-gate exit 0; 17*0Sstevel@tonic-gate } 18*0Sstevel@tonic-gate $| = 1; 19*0Sstevel@tonic-gate} 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gateuse strict; 22*0Sstevel@tonic-gate#use Test::More 'no_plan'; 23*0Sstevel@tonic-gateuse Test::More tests => 37; 24*0Sstevel@tonic-gateuse Encode qw(encode decode); 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gate# 27*0Sstevel@tonic-gate# see 28*0Sstevel@tonic-gate# http://www.unicode.org/unicode/reports/tr19/ 29*0Sstevel@tonic-gate# 30*0Sstevel@tonic-gate 31*0Sstevel@tonic-gatemy $dankogai = "\x{5c0f}\x{98fc}\x{3000}\x{5f3e}"; 32*0Sstevel@tonic-gatemy $nasty = "$dankogai\x{1abcd}"; 33*0Sstevel@tonic-gatemy $fallback = "$dankogai\x{fffd}"; 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gate#hi: (0x1abcd - 0x10000) / 0x400 + 0xD800 = 0xd82a 36*0Sstevel@tonic-gate#lo: (0x1abcd - 0x10000) % 0x400 + 0xDC00 = 0xdfcd 37*0Sstevel@tonic-gate 38*0Sstevel@tonic-gatemy $n_16be = 39*0Sstevel@tonic-gate pack("C*", map {hex($_)} qw<5c 0f 98 fc 30 00 5f 3e d8 2a df cd>); 40*0Sstevel@tonic-gatemy $n_16le = 41*0Sstevel@tonic-gate pack("C*", map {hex($_)} qw<0f 5c fc 98 00 30 3e 5f 2a d8 cd df>); 42*0Sstevel@tonic-gatemy $f_16be = 43*0Sstevel@tonic-gate pack("C*", map {hex($_)} qw<5c 0f 98 fc 30 00 5f 3e ff fd>); 44*0Sstevel@tonic-gatemy $f_16le = 45*0Sstevel@tonic-gate pack("C*", map {hex($_)} qw<0f 5c fc 98 00 30 3e 5f fd ff>); 46*0Sstevel@tonic-gatemy $n_32be = 47*0Sstevel@tonic-gate pack("C*", map {hex($_)} 48*0Sstevel@tonic-gate qw<00 00 5c 0f 00 00 98 fc 00 00 30 00 00 00 5f 3e 00 01 ab cd>); 49*0Sstevel@tonic-gatemy $n_32le = 50*0Sstevel@tonic-gate pack("C*", map {hex($_)} 51*0Sstevel@tonic-gate qw<0f 5c 00 00 fc 98 00 00 00 30 00 00 3e 5f 00 00 cd ab 01 00>); 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gatemy $n_16bb = pack('n', 0xFeFF) . $n_16be; 54*0Sstevel@tonic-gatemy $n_16lb = pack('v', 0xFeFF) . $n_16le; 55*0Sstevel@tonic-gatemy $n_32bb = pack('N', 0xFeFF) . $n_32be; 56*0Sstevel@tonic-gatemy $n_32lb = pack('V', 0xFeFF) . $n_32le; 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gateis($n_16be, encode('UTF-16BE', $nasty), qq{encode UTF-16BE}); 59*0Sstevel@tonic-gateis($n_16le, encode('UTF-16LE', $nasty), qq{encode UTF-16LE}); 60*0Sstevel@tonic-gateis($n_32be, encode('UTF-32BE', $nasty), qq{encode UTF-32BE}); 61*0Sstevel@tonic-gateis($n_32le, encode('UTF-32LE', $nasty), qq{encode UTF-16LE}); 62*0Sstevel@tonic-gate 63*0Sstevel@tonic-gateis($nasty, decode('UTF-16BE', $n_16be), qq{decode UTF-16BE}); 64*0Sstevel@tonic-gateis($nasty, decode('UTF-16LE', $n_16le), qq{decode UTF-16LE}); 65*0Sstevel@tonic-gateis($nasty, decode('UTF-32BE', $n_32be), qq{decode UTF-32BE}); 66*0Sstevel@tonic-gateis($nasty, decode('UTF-32LE', $n_32le), qq{decode UTF-32LE}); 67*0Sstevel@tonic-gate 68*0Sstevel@tonic-gateis($n_16bb, encode('UTF-16', $nasty), qq{encode UTF-16}); 69*0Sstevel@tonic-gateis($n_32bb, encode('UTF-32', $nasty), qq{encode UTF-32}); 70*0Sstevel@tonic-gateis($nasty, decode('UTF-16', $n_16bb), qq{decode UTF-16, bom=be}); 71*0Sstevel@tonic-gateis($nasty, decode('UTF-16', $n_16lb), qq{decode UTF-16, bom=le}); 72*0Sstevel@tonic-gateis($nasty, decode('UTF-32', $n_32bb), qq{decode UTF-32, bom=be}); 73*0Sstevel@tonic-gateis($nasty, decode('UTF-32', $n_32lb), qq{decode UTF-32, bom=le}); 74*0Sstevel@tonic-gate 75*0Sstevel@tonic-gateis(decode('UCS-2BE', $n_16be), $fallback, "decode UCS-2BE: fallback"); 76*0Sstevel@tonic-gateis(decode('UCS-2LE', $n_16le), $fallback, "decode UCS-2LE: fallback"); 77*0Sstevel@tonic-gateeval { decode('UCS-2BE', $n_16be, 1) }; 78*0Sstevel@tonic-gateis (index($@,'UCS-2BE:'), 0, "decode UCS-2BE: exception"); 79*0Sstevel@tonic-gateeval { decode('UCS-2LE', $n_16le, 1) }; 80*0Sstevel@tonic-gateis (index($@,'UCS-2LE:'), 0, "decode UCS-2LE: exception"); 81*0Sstevel@tonic-gateis(encode('UCS-2BE', $nasty), $f_16be, "encode UCS-2BE: fallback"); 82*0Sstevel@tonic-gateis(encode('UCS-2LE', $nasty), $f_16le, "encode UCS-2LE: fallback"); 83*0Sstevel@tonic-gateeval { encode('UCS-2BE', $nasty, 1) }; 84*0Sstevel@tonic-gateis(index($@, 'UCS-2BE'), 0, "encode UCS-2BE: exception"); 85*0Sstevel@tonic-gateeval { encode('UCS-2LE', $nasty, 1) }; 86*0Sstevel@tonic-gateis(index($@, 'UCS-2LE'), 0, "encode UCS-2LE: exception"); 87*0Sstevel@tonic-gate 88*0Sstevel@tonic-gate# 89*0Sstevel@tonic-gate# SvGROW test for (en|de)code_xs 90*0Sstevel@tonic-gate# 91*0Sstevel@tonic-gateSKIP: { 92*0Sstevel@tonic-gate my $utf8 = ''; 93*0Sstevel@tonic-gate for my $j (0,0x10){ 94*0Sstevel@tonic-gate for my $i (0..0xffff){ 95*0Sstevel@tonic-gate $j == 0 and (0xD800 <= $i && $i <= 0xDFFF) and next; 96*0Sstevel@tonic-gate $utf8 .= ord($j+$i); 97*0Sstevel@tonic-gate } 98*0Sstevel@tonic-gate for my $major ('UTF-16', 'UTF-32'){ 99*0Sstevel@tonic-gate for my $minor ('BE', 'LE'){ 100*0Sstevel@tonic-gate my $enc = $major.$minor; 101*0Sstevel@tonic-gate is(decode($enc, encode($enc, $utf8)), $utf8, "$enc RT"); 102*0Sstevel@tonic-gate } 103*0Sstevel@tonic-gate } 104*0Sstevel@tonic-gate } 105*0Sstevel@tonic-gate}; 106*0Sstevel@tonic-gate 107*0Sstevel@tonic-gate# 108*0Sstevel@tonic-gate# CJKT vs. UTF-7 109*0Sstevel@tonic-gate# 110*0Sstevel@tonic-gate 111*0Sstevel@tonic-gateuse File::Spec; 112*0Sstevel@tonic-gateuse File::Basename; 113*0Sstevel@tonic-gate 114*0Sstevel@tonic-gatemy $dir = dirname(__FILE__); 115*0Sstevel@tonic-gateopendir my $dh, $dir or die "$dir:$!"; 116*0Sstevel@tonic-gatemy @file = sort grep {/\.utf$/o} readdir $dh; 117*0Sstevel@tonic-gateclosedir $dh; 118*0Sstevel@tonic-gatefor my $file (@file){ 119*0Sstevel@tonic-gate my $path = File::Spec->catfile($dir, $file); 120*0Sstevel@tonic-gate open my $fh, '<', $path or die "$path:$!"; 121*0Sstevel@tonic-gate my $content; 122*0Sstevel@tonic-gate if (PerlIO::Layer->find('perlio')){ 123*0Sstevel@tonic-gate binmode $fh => ':utf8'; 124*0Sstevel@tonic-gate $content = join('' => <$fh>); 125*0Sstevel@tonic-gate }else{ # ugh! 126*0Sstevel@tonic-gate binmode $fh; 127*0Sstevel@tonic-gate $content = join('' => <$fh>); 128*0Sstevel@tonic-gate Encode::_utf8_on($content) 129*0Sstevel@tonic-gate } 130*0Sstevel@tonic-gate close $fh; 131*0Sstevel@tonic-gate is(decode("UTF-7", encode("UTF-7", $content)), $content, 132*0Sstevel@tonic-gate "UTF-7 RT:$file"); 133*0Sstevel@tonic-gate} 134*0Sstevel@tonic-gate1; 135*0Sstevel@tonic-gate__END__ 136