1#! /usr/local/bin/perl -w 2 3# vim: tabstop=4 4# vim: syntax=perl 5 6use strict; 7 8use Test; 9 10BEGIN { 11 plan tests => 7; 12} 13 14use Locale::Recode; 15 16sub int2utf8; 17 18my $local2ucs = {}; 19my $ucs2local = {}; 20 21while (<DATA>) { 22 my ($code, $ucs, undef) = map { oct $_ } split /\s+/, $_; 23 $local2ucs->{$code} = $ucs; 24 $ucs2local->{$ucs} = $code unless $ucs == 0xfffd; 25} 26 27my $cd_int = Locale::Recode->new (from => 'IBM273', 28 to => 'INTERNAL'); 29ok !$cd_int->getError; 30 31my $cd_utf8 = Locale::Recode->new (from => 'IBM273', 32 to => 'UTF-8'); 33ok !$cd_utf8->getError; 34 35my $cd_rev = Locale::Recode->new (from => 'INTERNAL', 36 to => 'IBM273'); 37ok !$cd_rev->getError; 38 39# Convert into internal representation. 40my $result_int = 1; 41while (my ($code, $ucs) = each %$local2ucs) { 42 my $outbuf = chr $code; 43 my $result = $cd_int->recode ($outbuf); 44 unless ($result && $outbuf->[0] == $ucs) { 45 $result_int = 0; 46 last; 47 } 48} 49ok $result_int; 50 51# Convert to UTF-8. 52my $result_utf8 = 1; 53while (my ($code, $ucs) = each %$local2ucs) { 54 my $outbuf = chr $code; 55 my $result = $cd_utf8->recode ($outbuf); 56 unless ($result && $outbuf eq int2utf8 $ucs) { 57 $result_utf8 = 0; 58 last; 59 } 60} 61ok $result_utf8; 62 63# Convert from internal representation. 64my $result_rev = 1; 65while (my ($ucs, $code) = each %$ucs2local) { 66 my $outbuf = [ $ucs ]; 67 my $result = $cd_rev->recode ($outbuf); 68 unless ($result && $code == ord $outbuf) { 69 $result_int = 0; 70 last; 71 } 72} 73ok $result_int; 74 75# Check handling of unknown characters. 76my $test_string1 = [ unpack 'c*', ' Supergirl ' ]; 77$test_string1->[0] = 0xad0be; 78$test_string1->[-1] = 0xbeefbabe; 79my $test_string2 = [ unpack 'c*', 'Supergirl' ]; 80 81my $unknown = "\x6f"; # Unknown character! 82 83$cd_rev = Locale::Recode->new (from => 'INTERNAL', 84 to => 'IBM273', 85 ) 86&& $cd_rev->recode ($test_string1) 87&& $cd_rev->recode ($test_string2) 88&& ($test_string2 = $unknown . $test_string2 . $unknown); 89 90ok $test_string1 eq $test_string2; 91 92sub int2utf8 93{ 94 my $ucs4 = shift; 95 96 if ($ucs4 <= 0x7f) { 97 return chr $ucs4; 98 } elsif ($ucs4 <= 0x7ff) { 99 return pack ("C2", 100 (0xc0 | (($ucs4 >> 6) & 0x1f)), 101 (0x80 | ($ucs4 & 0x3f))); 102 } elsif ($ucs4 <= 0xffff) { 103 return pack ("C3", 104 (0xe0 | (($ucs4 >> 12) & 0xf)), 105 (0x80 | (($ucs4 >> 6) & 0x3f)), 106 (0x80 | ($ucs4 & 0x3f))); 107 } elsif ($ucs4 <= 0x1fffff) { 108 return pack ("C4", 109 (0xf0 | (($ucs4 >> 18) & 0x7)), 110 (0x80 | (($ucs4 >> 12) & 0x3f)), 111 (0x80 | (($ucs4 >> 6) & 0x3f)), 112 (0x80 | ($ucs4 & 0x3f))); 113 } elsif ($ucs4 <= 0x3ffffff) { 114 return pack ("C5", 115 (0xf0 | (($ucs4 >> 24) & 0x3)), 116 (0x80 | (($ucs4 >> 18) & 0x3f)), 117 (0x80 | (($ucs4 >> 12) & 0x3f)), 118 (0x80 | (($ucs4 >> 6) & 0x3f)), 119 (0x80 | ($ucs4 & 0x3f))); 120 } else { 121 return pack ("C6", 122 (0xf0 | (($ucs4 >> 30) & 0x3)), 123 (0x80 | (($ucs4 >> 24) & 0x1)), 124 (0x80 | (($ucs4 >> 18) & 0x3f)), 125 (0x80 | (($ucs4 >> 12) & 0x3f)), 126 (0x80 | (($ucs4 >> 6) & 0x3f)), 127 (0x80 | ($ucs4 & 0x3f))); 128 } 129} 130 131#Local Variables: 132#mode: perl 133#perl-indent-level: 4 134#perl-continued-statement-offset: 4 135#perl-continued-brace-offset: 0 136#perl-brace-offset: -4 137#perl-brace-imaginary-offset: 0 138#perl-label-offset: -4 139#tab-width: 4 140#End: 141 142 143__DATA__ 1440x00 0x0000 1450x01 0x0001 1460x02 0x0002 1470x03 0x0003 1480x04 0x009c 1490x05 0x0009 1500x06 0x0086 1510x07 0x007f 1520x08 0x0097 1530x09 0x008d 1540x0a 0x008e 1550x0b 0x000b 1560x0c 0x000c 1570x0d 0x000d 1580x0e 0x000e 1590x0f 0x000f 1600x10 0x0010 1610x11 0x0011 1620x12 0x0012 1630x13 0x0013 1640x14 0x009d 1650x15 0x0085 1660x16 0x0008 1670x17 0x0087 1680x18 0x0018 1690x19 0x0019 1700x1a 0x0092 1710x1b 0x008f 1720x1c 0x001c 1730x1d 0x001d 1740x1e 0x001e 1750x1f 0x001f 1760x20 0x0080 1770x21 0x0081 1780x22 0x0082 1790x23 0x0083 1800x24 0x0084 1810x25 0x000a 1820x26 0x0017 1830x27 0x001b 1840x28 0x0088 1850x29 0x0089 1860x2a 0x008a 1870x2b 0x008b 1880x2c 0x008c 1890x2d 0x0005 1900x2e 0x0006 1910x2f 0x0007 1920x30 0x0090 1930x31 0x0091 1940x32 0x0016 1950x33 0x0093 1960x34 0x0094 1970x35 0x0095 1980x36 0x0096 1990x37 0x0004 2000x38 0x0098 2010x39 0x0099 2020x3a 0x009a 2030x3b 0x009b 2040x3c 0x0014 2050x3d 0x0015 2060x3e 0x009e 2070x3f 0x001a 2080x40 0x0020 2090x41 0x00a0 2100x42 0x00e2 2110x43 0x007b 2120x44 0x00e0 2130x45 0x00e1 2140x46 0x00e3 2150x47 0x00e5 2160x48 0x00e7 2170x49 0x00f1 2180x4a 0x00c4 2190x4b 0x002e 2200x4c 0x003c 2210x4d 0x0028 2220x4e 0x002b 2230x4f 0x0021 2240x50 0x0026 2250x51 0x00e9 2260x52 0x00ea 2270x53 0x00eb 2280x54 0x00e8 2290x55 0x00ed 2300x56 0x00ee 2310x57 0x00ef 2320x58 0x00ec 2330x59 0x007e 2340x5a 0x00dc 2350x5b 0x0024 2360x5c 0x002a 2370x5d 0x0029 2380x5e 0x003b 2390x5f 0x005e 2400x60 0x002d 2410x61 0x002f 2420x62 0x00c2 2430x63 0x005b 2440x64 0x00c0 2450x65 0x00c1 2460x66 0x00c3 2470x67 0x00c5 2480x68 0x00c7 2490x69 0x00d1 2500x6a 0x00f6 2510x6b 0x002c 2520x6c 0x0025 2530x6d 0x005f 2540x6e 0x003e 2550x6f 0x003f 2560x70 0x00f8 2570x71 0x00c9 2580x72 0x00ca 2590x73 0x00cb 2600x74 0x00c8 2610x75 0x00cd 2620x76 0x00ce 2630x77 0x00cf 2640x78 0x00cc 2650x79 0x0060 2660x7a 0x003a 2670x7b 0x0023 2680x7c 0x00a7 2690x7d 0x0027 2700x7e 0x003d 2710x7f 0x0022 2720x80 0x00d8 2730x81 0x0061 2740x82 0x0062 2750x83 0x0063 2760x84 0x0064 2770x85 0x0065 2780x86 0x0066 2790x87 0x0067 2800x88 0x0068 2810x89 0x0069 2820x8a 0x00ab 2830x8b 0x00bb 2840x8c 0x00f0 2850x8d 0x00fd 2860x8e 0x00fe 2870x8f 0x00b1 2880x90 0x00b0 2890x91 0x006a 2900x92 0x006b 2910x93 0x006c 2920x94 0x006d 2930x95 0x006e 2940x96 0x006f 2950x97 0x0070 2960x98 0x0071 2970x99 0x0072 2980x9a 0x00aa 2990x9b 0x00ba 3000x9c 0x00e6 3010x9d 0x00b8 3020x9e 0x00c6 3030x9f 0x00a4 3040xa0 0x00b5 3050xa1 0x00df 3060xa2 0x0073 3070xa3 0x0074 3080xa4 0x0075 3090xa5 0x0076 3100xa6 0x0077 3110xa7 0x0078 3120xa8 0x0079 3130xa9 0x007a 3140xaa 0x00a1 3150xab 0x00bf 3160xac 0x00d0 3170xad 0x00dd 3180xae 0x00de 3190xaf 0x00ae 3200xb0 0x00a2 3210xb1 0x00a3 3220xb2 0x00a5 3230xb3 0x00b7 3240xb4 0x00a9 3250xb5 0x0040 3260xb6 0x00b6 3270xb7 0x00bc 3280xb8 0x00bd 3290xb9 0x00be 3300xba 0x00ac 3310xbb 0x007c 3320xbc 0x203e 3330xbd 0x00a8 3340xbe 0x00b4 3350xbf 0x00d7 3360xc0 0x00e4 3370xc1 0x0041 3380xc2 0x0042 3390xc3 0x0043 3400xc4 0x0044 3410xc5 0x0045 3420xc6 0x0046 3430xc7 0x0047 3440xc8 0x0048 3450xc9 0x0049 3460xca 0x00ad 3470xcb 0x00f4 3480xcc 0x00a6 3490xcd 0x00f2 3500xce 0x00f3 3510xcf 0x00f5 3520xd0 0x00fc 3530xd1 0x004a 3540xd2 0x004b 3550xd3 0x004c 3560xd4 0x004d 3570xd5 0x004e 3580xd6 0x004f 3590xd7 0x0050 3600xd8 0x0051 3610xd9 0x0052 3620xda 0x00b9 3630xdb 0x00fb 3640xdc 0x007d 3650xdd 0x00f9 3660xde 0x00fa 3670xdf 0x00ff 3680xe0 0x00d6 3690xe1 0x00f7 3700xe2 0x0053 3710xe3 0x0054 3720xe4 0x0055 3730xe5 0x0056 3740xe6 0x0057 3750xe7 0x0058 3760xe8 0x0059 3770xe9 0x005a 3780xea 0x00b2 3790xeb 0x00d4 3800xec 0x005c 3810xed 0x00d2 3820xee 0x00d3 3830xef 0x00d5 3840xf0 0x0030 3850xf1 0x0031 3860xf2 0x0032 3870xf3 0x0033 3880xf4 0x0034 3890xf5 0x0035 3900xf6 0x0036 3910xf7 0x0037 3920xf8 0x0038 3930xf9 0x0039 3940xfa 0x00b3 3950xfb 0x00db 3960xfc 0x005d 3970xfd 0x00d9 3980xfe 0x00da 3990xff 0x009f 400