ext/Encode/t/at-cn.t

   1 BEGIN {
   2     if ($ENV{'PERL_CORE'}){
   3         chdir 't';
   4         unshift @INC, '../lib';
   5     }
   6     require Config; import Config;
   7     if ($Config{'extensions'} !~ /\bEncode\b/) {
   8       print "1..0 # Skip: Encode was not built\n";
   9       exit 0;
  10     }
  11     if (ord("A") == 193) {
  12         print "1..0 # Skip: EBCDIC\n";
  13         exit 0;
  14     }
  15     $| = 1;
  16 }
  17
  18 use strict;
  19 use Test::More tests => 29;
  20 use Encode;
  21
  22 no utf8; # we have raw Chinese encodings here
  23
  24 use_ok('Encode::CN');
  25
  26 # Since JP.t already tests basic file IO, we will just focus on
  27 # internal encode / decode test here. Unfortunately, to test
  28 # against all the UniHan characters will take a huge disk space,
  29 # not to mention the time it will take, and the fact that Perl
  30 # did not bundle UniHan.txt anyway.
  31
  32 # So, here we just test a typical snippet spanning multiple Unicode
  33 # blocks, and hope it can point out obvious errors.
  34
  35 run_tests('Simplified Chinese only', {
  36     'utf'       => (
  37 pack('U*',12298,26131,32463,12299,31532,19968,21350).
  38 pack('U*',24406,26352,65306).
  39 pack('U*',22823,21705,20094,20803,65292,19975,29289,36164,22987,65292).
  40 pack('U*',20035,32479,22825,12290).
  41 pack('U*',20113,34892,38632,26045,65292,21697,29289,27969,24418,12290).
  42 pack('U*',22823,26126,22987,32456,65292,20845,20301,26102,25104,65292).
  43 pack('U*',26102,20056,20845,40857,20197,24481,22825,12290).
  44 pack('U*',20094,36947,21464,21270,65292,21508,27491,24615,21629,65292).
  45 pack('U*',20445,21512,22823,21644,65292,20035,21033,36126,12290).
  46 pack('U*',39318,20986,24246,29289,65292,19975,22269,21688,23425,12290)
  47     ),
  48
  49     'euc-cn'    => join('',
  50 '¡¶Ò×¾¡·µÚÒ»ØÔ',
  51 'åèÔ»£º',
  52 '´óÔÕÇ¬Ôª£¬ÍòÎï×ÊÊ¼£¬',
  53 'ÄËÍ³Ìì¡£',
  54 'ÔÆÐÐÓêÊ©£¬Æ·ÎïÁ÷ÐÎ¡£',
  55 '´óÃ÷Ê¼ÖÕ£¬ÁùÎ»Ê±³É£¬',
  56 'Ê±³ËÁùÁúÒÔÓùÌì¡£',
  57 'Ç¬µÀ±ä»¯£¬¸÷ÕýÐÔÃü£¬',
  58 '±£ºÏ´óºÍ£¬ÄËÀûÕê¡£',
  59 'Ê×³öÊüÎï£¬Íò¹úÏÌÄþ¡£',
  60     ),
  61
  62     'gb2312-raw'        => join('',
  63 '!6RW>-!75ZR;XT',
  64 'ehT;#:',
  65 '4sTUG,T*#,MrNoWJJ<#,',
  66 'DKM3Ll!#',
  67 'TFPPSjJ)#,F7NoAwPN!#',
  68 '4sCwJ<VU#,AyN;J13I#,',
  69 'J13KAyAzRTSyLl!#',
  70 'G,5@1d;/#,8wU}PTC|#,',
  71 '1#:O4s:M#,DK@{Uj!#',
  72 'JW3vJ|No#,Mr9zOLD~!#'
  73     ),
  74
  75     'iso-ir-165'=> join('',
  76 '!6RW>-!75ZR;XT',
  77 'ehT;#:',
  78 '4sTUG,T*#,MrNoWJJ<#,',
  79 'DKM3Ll!#',
  80 'TFPPSjJ)#,F7NoAwPN!#',
  81 '4sCwJ<VU#,AyN;J13I#,',
  82 'J13KAyAzRTSyLl!#',
  83 'G,5@1d;/#,8wU}PTC|#,',
  84 '1#:O4s:M#,DK@{Uj!#',
  85 'JW3vJ|No#,Mr9zOLD~!#'
  86     ),
  87 });
  88
  89 run_tests('Simplified Chinese + ASCII', {
  90     'utf'       => (
  91 pack('U*',35937,26352,65306,10).
  92 pack('U*',22825,34892,20581,65292,21531,23376,20197,33258,24378,19981,24687,12290,10).
  93 pack('U*',28508,40857,21247,29992,65292,38451,22312,19979,20063,12290,32).
  94 pack('U*',35265,40857,22312,30000,65292,24503,26045,26222,20063,12290,32).
  95 pack('U*',32456,26085,20094,20094,65292,21453,22797,36947,20063,12290,10).
  96 pack('U*',25110,36291,22312,28170,65292,36827,26080,21646,20063,12290,39134).
  97 pack('U*',40857,22312,22825,65292,22823,20154,36896,20063,12290,32).
  98 pack('U*',20130,40857,26377,24724,65292,30408,19981,21487,20037,20063,12290,10).
  99 pack('U*',29992,20061,65292,22825,24503,19981,21487,20026,39318,20063,12290)
 100     ),
 101
 102     'cp936'     => join(chr(10),
 103 'ÏóÔ»£º',
 104 'ÌìÐÐ½¡£¬¾ý×ÓÒÔ×ÔÇ¿²»Ï¢¡£',
 105 'Ç±ÁúÎðÓÃ£¬ÑôÔÚÏÂÒ²¡£ ¼ûÁúÔÚÌï£¬µÂÊ©ÆÕÒ²¡£ ÖÕÈÕÇ¬Ç¬£¬·´¸´µÀÒ²¡£',
 106 '»òÔ¾ÔÚÔ¨£¬½øÎÞ¾ÌÒ²¡£·ÉÁúÔÚÌì£¬´óÈËÔìÒ²¡£ ¿ºÁúÓÐ»Ú£¬Ó¯²»¿É¾ÃÒ²¡£',
 107 'ÓÃ¾Å£¬ÌìµÂ²»¿ÉÎªÊ×Ò²¡£',
 108     ),
 109
 110     'hz'        => join(chr(10),
 111 '~{OsT;#:~}',
 112 '~{LlPP=!#,>}WSRTWTG?2;O"!#~}',
 113 '~{G1AzNpSC#,QtTZOBR2!#~} ~{<{AzTZLo#,5BJ)FUR2!#~} ~{VUHUG,G,#,74845@R2!#~}',
 114 '~{;rT>TZT(#,=xN^>LR2!#7IAzTZLl#,4sHKTlR2!#~} ~{?:AzSP;Z#,S/2;?I>CR2!#~}',
 115 '~{SC>E#,Ll5B2;?IN*JWR2!#~}',
 116     ),
 117 });
 118
 119 run_tests('Traditional Chinese', {
 120     'utf',      => pack('U*',20094,65306,20803,12289,20136,12289,21033,12289,35998),
 121     'gb12345-raw'       => 'G,#:T*!":`!"@{!"Uj',
 122     'gbk'       => 'Ç¬£ºÔª¡¢ºà¡¢Àû¡¢Ø',
 123 });
 124
 125 sub run_tests {
 126     my ($title, $tests) = @_;
 127     my $utf = delete $tests->{'utf'};
 128
 129     # $enc = encoding, $str = content
 130     foreach my $enc (sort keys %{$tests}) {
 131         my $str = $tests->{$enc};
 132
 133         is(Encode::decode($enc, $str), $utf, "[$enc] decode - $title");
 134         is(Encode::encode($enc, $utf), $str, "[$enc] encode - $title");
 135
 136         my $str2 = $str;
 137         my $utf8 = Encode::encode('utf-8', $utf);
 138
 139         Encode::from_to($str2, $enc, 'utf-8');
 140         is($str2, $utf8, "[$enc] from_to => utf8 - $title");
 141
 142         Encode::from_to($utf8, 'utf-8', $enc); # convert $utf8 as $enc
 143         is($utf8, $str,  "[$enc] utf8 => from_to - $title");
 144     }
 145 }