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 => 'KOI8-RU',
28				  to => 'INTERNAL');
29ok !$cd_int->getError;
30
31my $cd_utf8 = Locale::Recode->new (from => 'KOI8-RU',
32				   to => 'UTF-8');
33ok !$cd_utf8->getError;
34
35my $cd_rev = Locale::Recode->new (from => 'INTERNAL',
36				  to => 'KOI8-RU');
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 => 'KOI8-RU',
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	0x0004
1490x05	0x0005
1500x06	0x0006
1510x07	0x0007
1520x08	0x0008
1530x09	0x0009
1540x0a	0x000a
1550x0b	0x000b
1560x0c	0x000c
1570x0d	0x000d
1580x0e	0x000e
1590x0f	0x000f
1600x10	0x0010
1610x11	0x0011
1620x12	0x0012
1630x13	0x0013
1640x14	0x0014
1650x15	0x0015
1660x16	0x0016
1670x17	0x0017
1680x18	0x0018
1690x19	0x0019
1700x1a	0x001a
1710x1b	0x001b
1720x1c	0x001c
1730x1d	0x001d
1740x1e	0x001e
1750x1f	0x001f
1760x20	0x0020
1770x21	0x0021
1780x22	0x0022
1790x23	0x0023
1800x24	0x0024
1810x25	0x0025
1820x26	0x0026
1830x27	0x0027
1840x28	0x0028
1850x29	0x0029
1860x2a	0x002a
1870x2b	0x002b
1880x2c	0x002c
1890x2d	0x002d
1900x2e	0x002e
1910x2f	0x002f
1920x30	0x0030
1930x31	0x0031
1940x32	0x0032
1950x33	0x0033
1960x34	0x0034
1970x35	0x0035
1980x36	0x0036
1990x37	0x0037
2000x38	0x0038
2010x39	0x0039
2020x3a	0x003a
2030x3b	0x003b
2040x3c	0x003c
2050x3d	0x003d
2060x3e	0x003e
2070x3f	0x003f
2080x40	0x0040
2090x41	0x0041
2100x42	0x0042
2110x43	0x0043
2120x44	0x0044
2130x45	0x0045
2140x46	0x0046
2150x47	0x0047
2160x48	0x0048
2170x49	0x0049
2180x4a	0x004a
2190x4b	0x004b
2200x4c	0x004c
2210x4d	0x004d
2220x4e	0x004e
2230x4f	0x004f
2240x50	0x0050
2250x51	0x0051
2260x52	0x0052
2270x53	0x0053
2280x54	0x0054
2290x55	0x0055
2300x56	0x0056
2310x57	0x0057
2320x58	0x0058
2330x59	0x0059
2340x5a	0x005a
2350x5b	0x005b
2360x5c	0x005c
2370x5d	0x005d
2380x5e	0x005e
2390x5f	0x005f
2400x60	0x0060
2410x61	0x0061
2420x62	0x0062
2430x63	0x0063
2440x64	0x0064
2450x65	0x0065
2460x66	0x0066
2470x67	0x0067
2480x68	0x0068
2490x69	0x0069
2500x6a	0x006a
2510x6b	0x006b
2520x6c	0x006c
2530x6d	0x006d
2540x6e	0x006e
2550x6f	0x006f
2560x70	0x0070
2570x71	0x0071
2580x72	0x0072
2590x73	0x0073
2600x74	0x0074
2610x75	0x0075
2620x76	0x0076
2630x77	0x0077
2640x78	0x0078
2650x79	0x0079
2660x7a	0x007a
2670x7b	0x007b
2680x7c	0x007c
2690x7d	0x007d
2700x7e	0x007e
2710x7f	0x007f
2720x80	0x2500
2730x81	0x2502
2740x82	0x250c
2750x83	0x2510
2760x84	0x2514
2770x85	0x2518
2780x86	0x251c
2790x87	0x2524
2800x88	0x252c
2810x89	0x2534
2820x8a	0x253c
2830x8b	0x2580
2840x8c	0x2584
2850x8d	0x2588
2860x8e	0x258c
2870x8f	0x2590
2880x90	0x2591
2890x91	0x2592
2900x92	0x2593
2910x93	0x2320
2920x94	0x25a0
2930x95	0x2219
2940x96	0x221a
2950x97	0x2248
2960x98	0x2264
2970x99	0x2265
2980x9a	0x00a0
2990x9b	0x2321
3000x9c	0x00b0
3010x9d	0x00b2
3020x9e	0x00b7
3030x9f	0x00f7
3040xa0	0x2550
3050xa1	0x2551
3060xa2	0x2552
3070xa3	0x0451
3080xa4	0x0454
3090xa5	0x2554
3100xa6	0x0456
3110xa7	0x0457
3120xa8	0x2557
3130xa9	0x2558
3140xaa	0x2559
3150xab	0x255a
3160xac	0x255b
3170xad	0x0491
3180xae	0x045e
3190xaf	0x255e
3200xb0	0x255f
3210xb1	0x2560
3220xb2	0x2561
3230xb3	0x0401
3240xb4	0x0404
3250xb5	0x2563
3260xb6	0x0406
3270xb7	0x0407
3280xb8	0x2566
3290xb9	0x2567
3300xba	0x2568
3310xbb	0x2569
3320xbc	0x256a
3330xbd	0x0490
3340xbe	0x040e
3350xbf	0x00a9
3360xc0	0x044e
3370xc1	0x0430
3380xc2	0x0431
3390xc3	0x0446
3400xc4	0x0434
3410xc5	0x0435
3420xc6	0x0444
3430xc7	0x0433
3440xc8	0x0445
3450xc9	0x0438
3460xca	0x0439
3470xcb	0x043a
3480xcc	0x043b
3490xcd	0x043c
3500xce	0x043d
3510xcf	0x043e
3520xd0	0x043f
3530xd1	0x044f
3540xd2	0x0440
3550xd3	0x0441
3560xd4	0x0442
3570xd5	0x0443
3580xd6	0x0436
3590xd7	0x0432
3600xd8	0x044c
3610xd9	0x044b
3620xda	0x0437
3630xdb	0x0448
3640xdc	0x044d
3650xdd	0x0449
3660xde	0x0447
3670xdf	0x044a
3680xe0	0x042e
3690xe1	0x0410
3700xe2	0x0411
3710xe3	0x0426
3720xe4	0x0414
3730xe5	0x0415
3740xe6	0x0424
3750xe7	0x0413
3760xe8	0x0425
3770xe9	0x0418
3780xea	0x0419
3790xeb	0x041a
3800xec	0x041b
3810xed	0x041c
3820xee	0x041d
3830xef	0x041e
3840xf0	0x041f
3850xf1	0x042f
3860xf2	0x0420
3870xf3	0x0421
3880xf4	0x0422
3890xf5	0x0423
3900xf6	0x0416
3910xf7	0x0412
3920xf8	0x042c
3930xf9	0x042b
3940xfa	0x0417
3950xfb	0x0428
3960xfc	0x042d
3970xfd	0x0429
3980xfe	0x0427
3990xff	0x042a
400