1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..4\n"; }
END {print "not ok 1\n" unless $loaded;}
use Unicode::Map;
$loaded = 1;
print "ok 1\n";
print STDERR "\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
use strict;
my @test = (
map { ref($_) ? $_ : [$_] }
["CP936", "n->m: CP936"],
["GB2312", "n->m: GB2312 (GB2312-80^8080 + ISO8859-1)"],
["DEVANAGA", "n->m: DEVANAGA"],
);
{
my $max = 0;
my $len;
for (0..$#test) {
$len = length($test[$_]->[$#{$test[$_]}]);
$max = $len if $len>$max;
}
my ($name, $desc);
my $i=2;
for (sort {$test[$a]->[$#{$test[$a]}] cmp $test[$b]->[$#{$test[$b]}]}
0..$#test
) {
($name, $desc) = @{$test[$_]};
$desc = $name if !defined $desc;
_out($max, $i, $desc);
test ($i++, eval "&$name($_, \"$name\")");
}
}
sub _out {
my $max = shift;
my $t = sprintf " #%2d: %s ", @_;
$t .= "." x (9 + 4 + $max - length($t));
printf STDERR "$t ";
}
sub test {
my ($number, $status) = @_;
if ($status) {
print STDERR "ok\n";
print "ok $number\n";
} else {
print STDERR "failed!\n";
print "not ok $number\n";
}
}
sub CP936 {
my $_locale =
"\xd5\xe2\xca\xc7\xd2\xbb\xb8\xf6\xc0\xfd\xd7\xd3".
"\xa3\xac\xc7\xeb\xb2\xe2\xca\xd4\xa1\xa3\x0d\x0d"
;
my $_unicode =
"\x8f\xd9\x66\x2f\x4e\x00\x4e\x2a\x4f\x8b\x5b\x50".
"\xff\x0c\x8b\xf7\x6d\x4b\x8b\xd5\x30\x02\x00\x0d".
"\00\x0d"
;
return testMapping ( "CP936", $_locale, $_unicode );
}
sub GB2312 {
my $_locale =
"<title>".
"\xc5\xb7\xbd\xf5\xc8\xfc"
."</title>"
;
my $_unicode =
"\00<\00t\00i\00t\00l\00e\00>".
"\x6b\x27\x95\x26\x8d\x5b"
."\00<\00/\00t\00i\00t\00l\00e\00>"
;
return testMapping ( "GB2312", $_locale, $_unicode );
}
sub DEVANAGA {
my $_locale =
"\xa1\xe9"
." ABc"
."\xa1\xf8"
."\xe8\xe8\xe8\xe9"
." "
;
my $_unicode =
"\x09\x50"
."\x00\x20\x00\x41\x00\x42\x00\x63"
."\x09\x01\x09\x6d"
."\x09\x4d\x20\x0c\x09\x4d\x20\x0d"
."\x00\x20\x00\x20"
;
return testMapping ( "APPLE-DEVANAGA", $_locale, $_unicode );
}
sub testMapping {
my ( $charsetId, $txtLocale, $txtUnicode ) = @_;
return 0 if ! ( my $Map = new Unicode::Map($charsetId) );
return 0 if $txtLocale ne $Map -> from_unicode ( $txtUnicode );
return 0 if $txtUnicode ne $Map -> to_unicode ( $txtLocale );
my $garbage = $Map -> from_unicode ( $txtLocale );
return 0 if $garbage && $txtLocale eq $garbage;
1}
|
