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
|
#!/usr/local/bin/perl
#
# $Id: rt.pl,v 2.0 2004/05/16 20:55:19 dankogai Exp $
#
BEGIN {
my $ucmdir = "ucm";
if ($ENV{'PERL_CORE'}){
chdir 't';
unshift @INC, '../lib';
$ucmdir = "../ext/Encode/ucm";
}
require Config; import Config;
if ($Config{'extensions'} !~ /\bEncode\b/) {
print "1..0 # Skip: Encode was not built\n";
exit 0;
}
if (ord("A") == 193) {
print "1..0 # Skip: EBCDIC\n";
exit 0;
}
use strict;
require Test::More;
our $DEBUG;
our @ucm;
unless(@ARGV){
use File::Spec;
Test::More->import(tests => 103);
opendir my $dh, $ucmdir or die "$ucmdir:$!";
@ucm =
map {File::Spec->catfile($ucmdir, $_) }
sort grep {/\.ucm$/o} readdir($dh);
closedir $dh;
}else{
Test::More->import("no_plan");
$DEBUG = 1;
@ucm = @ARGV;
}
}
use strict;
use Encode qw/encode decode/;
our $DEBUG;
our @ucm;
for my $ucm (@ucm){
my ($name, $nchar, $nrt, $nok) = rttest($ucm);
$nok += 0;
ok($nok == 0, "$ucm => $name ($nchar, $nrt, $nok)");
}
sub rttest{
my $ucm = shift;
my ($name, $nchar, $nrt, $nok);
open my $rfh, "<$ucm" or die "$ucm:$!";
# <U0000> \x00 |0 # <control>
while(<$rfh>){
s/#.*//o; /^$/ and next;
unless ($name){
/^<code_set_name>\s+"([^\"]+)"/io or next;
$name = $1 and next;
}else{
/^<U([0-9a-f]+)>\s+(\S+)\s+\|(\d)/io or next;
$nchar++;
$3 == 0 or next;
$nrt++;
my $uni = chr(hex($1));
my $enc = eval qq{ "$2" };
decode($name, $enc) eq $uni or $nok++;
encode($name, $uni) eq $enc or $nok++;
}
}
return($name, $nchar, $nrt, $nok);
}
__END__
|
