Commit | Line | Data |
ab3374e4 |
1 | #!/usr/local/bin/perl |
2 | # |
3 | # $Id: rt.pl,v 1.1 2002/10/20 15:44:00 dankogai Exp $ |
4 | # |
5 | |
6 | BEGIN { |
7 | if ($ENV{'PERL_CORE'}){ |
8 | chdir 't'; |
9 | unshift @INC, '../lib'; |
10 | } |
11 | require Config; import Config; |
12 | if ($Config{'extensions'} !~ /\bEncode\b/) { |
13 | print "1..0 # Skip: Encode was not built\n"; |
14 | exit 0; |
15 | } |
16 | if (ord("A") == 193) { |
17 | print "1..0 # Skip: EBCDIC\n"; |
18 | exit 0; |
19 | } |
20 | use strict; |
21 | require Test::More; |
22 | my $ucmdir = "ucm"; |
23 | our $DEBUG; |
24 | our @ucm; |
25 | unless(@ARGV){ |
26 | use File::Spec; |
27 | Test::More->import(tests => 103); |
28 | opendir my $dh, $ucmdir or die "$ucmdir:$!"; |
29 | @ucm = |
30 | map {File::Spec->catfile($ucmdir, $_) } |
31 | sort grep {/\.ucm$/o} readdir($dh); |
32 | closedir $dh; |
33 | }else{ |
34 | Test::More->import("no_plan"); |
35 | $DEBUG = 1; |
36 | @ucm = @ARGV; |
37 | } |
38 | } |
39 | |
40 | use strict; |
41 | use Encode qw/encode decode/; |
42 | our $DEBUG; |
43 | our @ucm; |
44 | |
45 | for my $ucm (@ucm){ |
46 | my ($name, $nchar, $nrt, $nok) = rttest($ucm); |
47 | $nok += 0; |
48 | ok($nok == 0, "$ucm => $name ($nchar, $nrt, $nok)"); |
49 | } |
50 | |
51 | sub rttest{ |
52 | my $ucm = shift; |
53 | my ($name, $nchar, $nrt, $nok); |
54 | open my $rfh, "<$ucm" or die "$ucm:$!"; |
55 | # <U0000> \x00 |0 # <control> |
56 | while(<$rfh>){ |
57 | s/#.*//o; /^$/ and next; |
58 | unless ($name){ |
59 | /^<code_set_name>\s+"([^\"]+)"/io or next; |
60 | $name = $1 and next; |
61 | }else{ |
62 | /^<U([0-9a-f]+)>\s+(\S+)\s+\|(\d)/io or next; |
63 | $nchar++; |
64 | $3 == 0 or next; |
65 | $nrt++; |
66 | my $uni = chr(hex($1)); |
67 | my $enc = eval qq{ "$2" }; |
68 | decode($name, $enc) eq $uni or $nok++; |
69 | encode($name, $uni) eq $enc or $nok++; |
70 | } |
71 | } |
72 | return($name, $nchar, $nrt, $nok); |
73 | } |
74 | __END__ |