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 => 'IBM424',
28				  to => 'INTERNAL');
29ok !$cd_int->getError;
30
31my $cd_utf8 = Locale::Recode->new (from => 'IBM424',
32				   to => 'UTF-8');
33ok !$cd_utf8->getError;
34
35my $cd_rev = Locale::Recode->new (from => 'INTERNAL',
36				  to => 'IBM424');
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 => 'IBM424',
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	0x05d0
2100x42	0x05d1
2110x43	0x05d2
2120x44	0x05d3
2130x45	0x05d4
2140x46	0x05d5
2150x47	0x05d6
2160x48	0x05d7
2170x49	0x05d8
2180x4a	0x00a2
2190x4b	0x002e
2200x4c	0x003c
2210x4d	0x0028
2220x4e	0x002b
2230x4f	0x007c
2240x50	0x0026
2250x51	0x05d9
2260x52	0x05da
2270x53	0x05db
2280x54	0x05dc
2290x55	0x05dd
2300x56	0x05de
2310x57	0x05df
2320x58	0x05e0
2330x59	0x05e1
2340x5a	0x0021
2350x5b	0x0024
2360x5c	0x002a
2370x5d	0x0029
2380x5e	0x003b
2390x5f	0x00ac
2400x60	0x002d
2410x61	0x002f
2420x62	0x05e2
2430x63	0x05e3
2440x64	0x05e4
2450x65	0x05e5
2460x66	0x05e6
2470x67	0x05e7
2480x68	0x05e8
2490x69	0x05e9
2500x6a	0x00a6
2510x6b	0x002c
2520x6c	0x0025
2530x6d	0x005f
2540x6e	0x003e
2550x6f	0x003f
2560x71	0xfffd
2570x71	0x05ea
2580x74	0xfffd
2590x74	0xfffd
2600x74	0x00a0
2610x78	0xfffd
2620x78	0xfffd
2630x78	0xfffd
2640x78	0x21d4
2650x79	0x0060
2660x7a	0x003a
2670x7b	0x0023
2680x7c	0x0040
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
2820x8a	0x00ab
2830x8b	0x00bb
2840x90	0xfffd
2850x90	0xfffd
2860x90	0xfffd
2870x90	0xfffd
2880x90	0x00b0
2890x91	0x006a
2900x92	0x006b
2910x93	0x006c
2920x94	0x006d
2930x95	0x006e
2940x96	0x006f
2950x97	0x0070
2960x98	0x0071
2970x99	0x0072
2980x9d	0xfffd
2990x9d	0xfffd
3000x9d	0xfffd
3010x9d	0x00b8
3020x9f	0xfffd
3030x9f	0x00a4
3040xa0	0x00b5
3050xa1	0x007e
3060xa2	0x0073
3070xa3	0x0074
3080xa4	0x0075
3090xa5	0x0076
3100xa6	0x0077
3110xa7	0x0078
3120xa8	0x0079
3130xa9	0x007a
3140xaf	0xfffd
3150xaf	0xfffd
3160xaf	0xfffd
3170xaf	0xfffd
3180xaf	0xfffd
3190xaf	0x00ae
3200xb0	0x005e
3210xb1	0x00a3
3220xb2	0x00a5
3230xb3	0x00b7
3240xb4	0x00a9
3250xb5	0x00a7
3260xb6	0x00b6
3270xb7	0x00bc
3280xb8	0x00bd
3290xb9	0x00be
3300xba	0x005b
3310xbb	0x005d
3320xbc	0x203e
3330xbd	0x00a8
3340xbe	0x00b4
3350xbf	0x00d7
3360xc0	0x007b
3370xc1	0x0041
3380xc2	0x0042
3390xc3	0x0043
3400xc4	0x0044
3410xc5	0x0045
3420xc6	0x0046
3430xc7	0x0047
3440xc8	0x0048
3450xc9	0x0049
3460xca	0x00ad
3470xd0	0xfffd
3480xd0	0xfffd
3490xd0	0xfffd
3500xd0	0xfffd
3510xd0	0xfffd
3520xd0	0x007d
3530xd1	0x004a
3540xd2	0x004b
3550xd3	0x004c
3560xd4	0x004d
3570xd5	0x004e
3580xd6	0x004f
3590xd7	0x0050
3600xd8	0x0051
3610xd9	0x0052
3620xda	0x00b9
3630xe0	0xfffd
3640xe0	0xfffd
3650xe0	0xfffd
3660xe0	0xfffd
3670xe0	0xfffd
3680xe0	0x005c
3690xe1	0x00f7
3700xe2	0x0053
3710xe3	0x0054
3720xe4	0x0055
3730xe5	0x0056
3740xe6	0x0057
3750xe7	0x0058
3760xe8	0x0059
3770xe9	0x005a
3780xea	0x00b2
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
3940xfa	0x00b3
3950xff	0xfffd
3960xff	0xfffd
3970xff	0xfffd
3980xff	0xfffd
3990xff	0x009f
400