ext/Encode/t/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     unless (find PerlIO::Layer 'perlio') {
  12         print "1..0 # Skip: PerlIO was not built\n";
  13         exit 0;
  14     }
  15     if (ord("A") == 193) {
  16         print "1..0 # Skip: EBCDIC\n";
  17         exit 0;
  18     }
  19     $| = 1;
  20 }
  21
  22 use strict;
  23 use Test::More tests => 29;
  24 use Encode;
  25
  26 use_ok('Encode::CN');
  27
  28 # Since JP.t already test basic file IO, we will just focus on
  29 # internal encode / decode test here. Unfortunately, to test
  30 # against all the UniHan characters will take a huge disk space,
  31 # not to mention the time it will take, and the fact that Perl
  32 # did not bundle UniHan.txt anyway.
  33
  34 # So, here we just test a typical snippet spanning multiple Unicode
  35 # blocks, and hope it can point out obvious errors.
  36
  37 run_tests('Simplified Chinese only', {
  38     'utf'       => (
  39 12298.26131.32463.12299.31532.19968.21350.
  40 24406.26352.65306.
  41 22823.21705.20094.20803.65292.19975.29289.36164.22987.65292.
  42 20035.32479.22825.12290.
  43 20113.34892.38632.26045.65292.21697.29289.27969.24418.12290.
  44 22823.26126.22987.32456.65292.20845.20301.26102.25104.65292.
  45 26102.20056.20845.40857.20197.24481.22825.12290.
  46 20094.36947.21464.21270.65292.21508.27491.24615.21629.65292.
  47 20445.21512.22823.21644.65292.20035.21033.36126.12290.
  48 39318.20986.24246.29289.65292.19975.22269.21688.23425.12290
  49     ),
  50
  51     'euc-cn'    => join('',
  52 '¡¶Ò×¾¡·µÚÒ»ØÔ',
  53 'åèÔ»£º',
  54 '´óÔÕÇ¬Ôª£¬ÍòÎï×ÊÊ¼£¬',
  55 'ÄËÍ³Ìì¡£',
  56 'ÔÆÐÐÓêÊ©£¬Æ·ÎïÁ÷ÐÎ¡£',
  57 '´óÃ÷Ê¼ÖÕ£¬ÁùÎ»Ê±³É£¬',
  58 'Ê±³ËÁùÁúÒÔÓùÌì¡£',
  59 'Ç¬µÀ±ä»¯£¬¸÷ÕýÐÔÃü£¬',
  60 '±£ºÏ´óºÍ£¬ÄËÀûÕê¡£',
  61 'Ê×³öÊüÎï£¬Íò¹úÏÌÄþ¡£',
  62     ),
  63
  64     'gb2312-raw'        => join('',
  65 '!6RW>-!75ZR;XT',
  66 'ehT;#:',
  67 '4sTUG,T*#,MrNoWJJ<#,',
  68 'DKM3Ll!#',
  69 'TFPPSjJ)#,F7NoAwPN!#',
  70 '4sCwJ<VU#,AyN;J13I#,',
  71 'J13KAyAzRTSyLl!#',
  72 'G,5@1d;/#,8wU}PTC|#,',
  73 '1#:O4s:M#,DK@{Uj!#',
  74 'JW3vJ|No#,Mr9zOLD~!#'
  75     ),
  76
  77     'iso-ir-165'=> join('',
  78 '!6RW>-!75ZR;XT',
  79 'ehT;#:',
  80 '4sTUG,T*#,MrNoWJJ<#,',
  81 'DKM3Ll!#',
  82 'TFPPSjJ)#,F7NoAwPN!#',
  83 '4sCwJ<VU#,AyN;J13I#,',
  84 'J13KAyAzRTSyLl!#',
  85 'G,5@1d;/#,8wU}PTC|#,',
  86 '1#:O4s:M#,DK@{Uj!#',
  87 'JW3vJ|No#,Mr9zOLD~!#'
  88     ),
  89 });
  90
  91 run_tests('Simplified Chinese + ASCII', {
  92     'utf'       => (
  93 35937.26352.65306.10.
  94 22825.34892.20581.65292.21531.23376.20197.33258.24378.19981.24687.12290.10.
  95 28508.40857.21247.29992.65292.38451.22312.19979.20063.12290.32.
  96 35265.40857.22312.30000.65292.24503.26045.26222.20063.12290.32.
  97 32456.26085.20094.20094.65292.21453.22797.36947.20063.12290.10.
  98 25110.36291.22312.28170.65292.36827.26080.21646.20063.12290.39134.
  99 40857.22312.22825.65292.22823.20154.36896.20063.12290.32.
 100 20130.40857.26377.24724.65292.30408.19981.21487.20037.20063.12290.10.
 101 29992.20061.65292.22825.24503.19981.21487.20026.39318.20063.12290
 102     ),
 103
 104     'cp936'     => join(chr(10),
 105 'ÏóÔ»£º',
 106 'ÌìÐÐ½¡£¬¾ý×ÓÒÔ×ÔÇ¿²»Ï¢¡£',
 107 'Ç±ÁúÎðÓÃ£¬ÑôÔÚÏÂÒ²¡£ ¼ûÁúÔÚÌï£¬µÂÊ©ÆÕÒ²¡£ ÖÕÈÕÇ¬Ç¬£¬·´¸´µÀÒ²¡£',
 108 '»òÔ¾ÔÚÔ¨£¬½øÎÞ¾ÌÒ²¡£·ÉÁúÔÚÌì£¬´óÈËÔìÒ²¡£ ¿ºÁúÓÐ»Ú£¬Ó¯²»¿É¾ÃÒ²¡£',
 109 'ÓÃ¾Å£¬ÌìµÂ²»¿ÉÎªÊ×Ò²¡£',
 110     ),
 111
 112     'hz'        => join(chr(10),
 113 '~{OsT;#:~}',
 114 '~{LlPP=!#,>}WSRTWTG?2;O"!#~}',
 115 '~{G1AzNpSC#,QtTZOBR2!#~} ~{<{AzTZLo#,5BJ)FUR2!#~} ~{VUHUG,G,#,74845@R2!#~}',
 116 '~{;rT>TZT(#,=xN^>LR2!#7IAzTZLl#,4sHKTlR2!#~} ~{?:AzSP;Z#,S/2;?I>CR2!#~}',
 117 '~{SC>E#,Ll5B2;?IN*JWR2!#~}',
 118     ),
 119 });
 120
 121 run_tests('Traditional Chinese', {
 122     'utf',      => 20094.65306.20803.12289.20136.12289.21033.12289.35998,
 123     'gb12345-raw'       => 'G,#:T*!":`!"@{!"Uj',
 124     'gbk'       => 'Ç¬£ºÔª¡¢ºà¡¢Àû¡¢Ø',
 125 });
 126
 127 sub run_tests {
 128     my ($title, $tests) = @_;
 129     my $utf = delete $tests->{'utf'};
 130
 131     # $enc = encoding, $str = content
 132     foreach my $enc (sort keys %{$tests}) {
 133         my $str = $tests->{$enc};
 134
 135         is(Encode::decode($enc, $str), $utf, "[$enc] decode - $title");
 136         is(Encode::encode($enc, $utf), $str, "[$enc] encode - $title");
 137
 138         my $str2 = $str;
 139         my $utf8 = Encode::encode('utf-8', $utf);
 140
 141         Encode::from_to($str2, $enc, 'utf-8');
 142         is($str2, $utf8, "[$enc] from_to => utf8 - $title");
 143
 144         Encode::from_to($utf8, 'utf-8', $enc); # convert $utf8 as $enc
 145         is($utf8, $str,  "[$enc] utf8 => from_to - $title");
 146     }
 147 }