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