t/lib/encode.t

   1 BEGIN {
   2     chdir 't' if -d 't';
   3     @INC = '../lib';
   4     require Config; import Config;
   5     if ($Config{'extensions'} !~ /\Encode\b/) {
   6       print "1..0 # Skip: Encode was not built\n";
   7       exit 0;
   8     }
   9 }
  10 use Test;
  11 use Encode qw(from_to);
  12 use charnames qw(greek);
  13 my @encodings = grep(/iso8859/,Encode::encodings());
  14 my $n = 2;
  15 my @character_set = ('0'..'9', 'A'..'Z', 'a'..'z');
  16 my @source = qw(ascii iso8859-1 cp1250);
  17 my @destiny = qw(cp1047 cp37 posix-bc);
  18 my @ebcdic_sets = qw(cp1047 cp37 posix-bc);
  19 plan test => 13+$n*@encodings + 2*@source*@destiny*@character_set + 2*@ebcdic_sets*256;
  20 my $str = join('',map(chr($_),0x20..0x7E));
  21 my $cpy = $str;
  22 ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong");
  23 ok($cpy,$str,"ASCII mangled by translating from iso8859-1 to Unicode");
  24 $cpy = $str;
  25 ok(from_to($cpy,'Unicode','iso8859-1'),length($str),"Length wrong");
  26 ok($cpy,$str,"ASCII mangled by translating from Unicode to iso8859-1");
  27
  28 $str = join('',map(chr($_),0xa0..0xff));
  29 $cpy = $str;
  30 ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong");
  31
  32 my $sym = Encode->getEncoding('symbol');
  33 my $uni = $sym->toUnicode('a');
  34 ok("\N{alpha}",substr($uni,0,1),"alpha does not map to symbol 'a'");
  35 $str = $sym->fromUnicode("\N{Beta}");
  36 ok("B",substr($str,0,1),"Symbol 'B' does not map to Beta");
  37
  38 foreach my $enc (qw(symbol dingbats ascii),@encodings)
  39  {
  40   my $tab = Encode->getEncoding($enc);
  41   ok(1,defined($tab),"Could not load $enc");
  42   $str = join('',map(chr($_),0x20..0x7E));
  43   $uni = $tab->toUnicode($str);
  44   $cpy = $tab->fromUnicode($uni);
  45   ok($cpy,$str,"$enc mangled translating to Unicode and back");
  46  }
  47
  48 # On ASCII based machines see if we can map several codepoints from
  49 # three distinct ASCII sets to three distinct EBCDIC coded character sets.
  50 # On EBCDIC machines see if we can map from three EBCDIC sets to three
  51 # distinct ASCII sets.
  52
  53 my @expectation = (240..249, 193..201,209..217,226..233, 129..137,145..153,162..169);
  54 if (ord('A') != 65) {
  55     my @temp = @destiny;
  56     @destiny = @source;
  57     @source = @temp;
  58     undef(@temp);
  59     @expectation = (48..57, 65..90, 97..122);
  60 }
  61
  62 foreach my $to (@destiny)
  63  {
  64   foreach my $from (@source)
  65    {
  66     my @expected = @expectation;
  67     foreach my $chr (@character_set)
  68      {
  69       my $native_chr = $chr;
  70       my $cpy = $chr;
  71       my $rc = from_to($cpy,$from,$to);
  72       ok(1,$rc,"Could not translate from $from to $to");
  73       ok(ord($cpy),shift(@expected),"mangled translating $native_chr from $from to $to");
  74      }
  75    }
  76  }
  77
  78 # On either ASCII or EBCDIC machines ensure we can take the full one
  79 # byte repetoire to EBCDIC sets and back.
  80
  81 my $enc_as = 'iso8859-1';
  82 foreach my $enc_eb (@ebcdic_sets)
  83  {
  84   foreach my $ord (0..255)
  85    {
  86     $str = chr($ord);
  87     my $rc = from_to($str,$enc_as,$enc_eb);
  88     $rc += from_to($str,$enc_eb,$enc_as);
  89     ok($rc,2,"return code for $ord $enc_eb -> $enc_as -> $enc_eb was not obtained");
  90     ok($ord,ord($str),"$enc_as mangled translating $ord to $enc_eb and back");
  91    }
  92  }
  93