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