ext/Encode/t/rt.pl

   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__