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 => 'EBCDIC-PT', 28 to => 'INTERNAL'); 29ok !$cd_int->getError; 30 31my $cd_utf8 = Locale::Recode->new (from => 'EBCDIC-PT', 32 to => 'UTF-8'); 33ok !$cd_utf8->getError; 34 35my $cd_rev = Locale::Recode->new (from => 'INTERNAL', 36 to => 'EBCDIC-PT'); 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 = "\x3f"; # Unknown character! 82 83$cd_rev = Locale::Recode->new (from => 'INTERNAL', 84 to => 'EBCDIC-PT', 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 2090x4a 0xfffd 2100x4a 0xfffd 2110x4a 0xfffd 2120x4a 0xfffd 2130x4a 0xfffd 2140x4a 0xfffd 2150x4a 0xfffd 2160x4a 0xfffd 2170x4a 0xfffd 2180x4a 0x005b 2190x4b 0x002e 2200x4c 0x003c 2210x4d 0x0028 2220x4e 0x002b 2230x4f 0x0021 2240x50 0x0026 2250x5a 0xfffd 2260x5a 0xfffd 2270x5a 0xfffd 2280x5a 0xfffd 2290x5a 0xfffd 2300x5a 0xfffd 2310x5a 0xfffd 2320x5a 0xfffd 2330x5a 0xfffd 2340x5a 0x005d 2350x5b 0x0024 2360x5c 0x002a 2370x5d 0x0029 2380x5e 0x003b 2390x5f 0x005e 2400x60 0x002d 2410x61 0x002f 2420x6a 0xfffd 2430x6a 0xfffd 2440x6a 0xfffd 2450x6a 0xfffd 2460x6a 0xfffd 2470x6a 0xfffd 2480x6a 0xfffd 2490x6a 0xfffd 2500x6a 0x00f5 2510x6b 0x002c 2520x6c 0x0025 2530x6d 0x005f 2540x6e 0x003e 2550x6f 0x003f 2560x79 0xfffd 2570x79 0xfffd 2580x79 0xfffd 2590x79 0xfffd 2600x79 0xfffd 2610x79 0xfffd 2620x79 0xfffd 2630x79 0xfffd 2640x79 0xfffd 2650x79 0x0060 2660x7a 0x003a 2670x7b 0x00c3 2680x7c 0x00d5 2690x7d 0x0027 2700x7e 0x003d 2710x7f 0x0022 2720x81 0xfffd 2730x81 0x0061 2740x82 0x0062 2750x83 0x0063 2760x84 0x0064 2770x85 0x0065 2780x86 0x0066 2790x87 0x0067 2800x88 0x0068 2810x89 0x0069 2820x91 0xfffd 2830x91 0xfffd 2840x91 0xfffd 2850x91 0xfffd 2860x91 0xfffd 2870x91 0xfffd 2880x91 0xfffd 2890x91 0x006a 2900x92 0x006b 2910x93 0x006c 2920x94 0x006d 2930x95 0x006e 2940x96 0x006f 2950x97 0x0070 2960x98 0x0071 2970x99 0x0072 2980xa1 0xfffd 2990xa1 0xfffd 3000xa1 0xfffd 3010xa1 0xfffd 3020xa1 0xfffd 3030xa1 0xfffd 3040xa1 0xfffd 3050xa1 0x00e7 3060xa2 0x0073 3070xa3 0x0074 3080xa4 0x0075 3090xa5 0x0076 3100xa6 0x0077 3110xa7 0x0078 3120xa8 0x0079 3130xa9 0x007a 3140xc0 0xfffd 3150xc0 0xfffd 3160xc0 0xfffd 3170xc0 0xfffd 3180xc0 0xfffd 3190xc0 0xfffd 3200xc0 0xfffd 3210xc0 0xfffd 3220xc0 0xfffd 3230xc0 0xfffd 3240xc0 0xfffd 3250xc0 0xfffd 3260xc0 0xfffd 3270xc0 0xfffd 3280xc0 0xfffd 3290xc0 0xfffd 3300xc0 0xfffd 3310xc0 0xfffd 3320xc0 0xfffd 3330xc0 0xfffd 3340xc0 0xfffd 3350xc0 0xfffd 3360xc0 0x00e3 3370xc1 0x0041 3380xc2 0x0042 3390xc3 0x0043 3400xc4 0x0044 3410xc5 0x0045 3420xc6 0x0046 3430xc7 0x0047 3440xc8 0x0048 3450xc9 0x0049 3460xd0 0xfffd 3470xd0 0xfffd 3480xd0 0xfffd 3490xd0 0xfffd 3500xd0 0xfffd 3510xd0 0xfffd 3520xd0 0x00b4 3530xd1 0x004a 3540xd2 0x004b 3550xd3 0x004c 3560xd4 0x004d 3570xd5 0x004e 3580xd6 0x004f 3590xd7 0x0050 3600xd8 0x0051 3610xd9 0x0052 3620xe0 0xfffd 3630xe0 0xfffd 3640xe0 0xfffd 3650xe0 0xfffd 3660xe0 0xfffd 3670xe0 0xfffd 3680xe0 0x00c7 3690xe2 0xfffd 3700xe2 0x0053 3710xe3 0x0054 3720xe4 0x0055 3730xe5 0x0056 3740xe6 0x0057 3750xe7 0x0058 3760xe8 0x0059 3770xe9 0x005a 3780xf0 0xfffd 3790xf0 0xfffd 3800xf0 0xfffd 3810xf0 0xfffd 3820xf0 0xfffd 3830xf0 0xfffd 3840xf0 0x0030 3850xf1 0x0031 3860xf2 0x0032 3870xf3 0x0033 3880xf4 0x0034 3890xf5 0x0035 3900xf6 0x0036 3910xf7 0x0037 3920xf8 0x0038 3930xf9 0x0039 3940xff 0xfffd 3950xff 0xfffd 3960xff 0xfffd 3970xff 0xfffd 3980xff 0xfffd 3990xff 0x009f 400