BEGIN { $| = 1; print "1..91\n"; } END {print "not ok 1\n" unless $loaded;} use String::Multibyte; $^W = 1; $loaded = 1; print "ok 1\n"; ##### sub asc2str ($$) { my($cs, $str) = @_; my $tmp = { UTF16LE => 'v', UTF32LE => 'V', UTF16BE => 'n', UTF32BE => 'N', }->{$cs}; $tmp and $str =~ s/([\x00-\xFF])/pack $tmp, ord $1/ge; return $str; } sub str2asc ($$) { my($cs, $str) = @_; my $re = { UTF16LE => '([\0-\xFF])\0', UTF32LE => '([\0-\xFF])\0\0\0', UTF16BE => '\0([\0-\xFF])', UTF32BE => '\0\0\0([\0-\xFF])', }->{$cs}; $re and $str =~ s/$re/$1/g; return $str; } ##### for $cs (qw/Bytes EUC EUC_JP ShiftJIS UTF8 UTF16BE UTF16LE UTF32BE UTF32LE Unicode/) { if ($cs eq 'Unicode' && $] < 5.008) { for (1..9) { print("ok ", ++$loaded, "\n"); } next; } $mb = String::Multibyte->new($cs,1); $strC = "abcdefg-123456789"; $strM = asc2str($cs, $strC); $cntC = $strC =~ tr'a-cd'15-7'; $cntM = $mb->strtr(\$strM, asc2str($cs, 'a-cd'), asc2str($cs, '15-7'),'R'); print $strC eq str2asc($cs, $strM) && $cntC == $cntM ? "ok" : "not ok", " ", ++$loaded, "\n"; @uc = ("", "I", "IA", "AIS", "ASIB","AAA"); @lc = ("", "i", "ia", "ais", "asib","aba"); @mod = ("", "d", "c", "cd", "s", "sd", "sc", "scd"); $str = "THIS IS A PEN. YOU ARE A RABBIT."; for $m (0..$#mod) { $NG = 0; for $i (0..$#uc) { for $j(0..$#lc) { $strC = $str; $strM = asc2str($cs, $str); $ucP = asc2str($cs, $uc[$i]); $lcP = asc2str($cs, $lc[$j]); $cntC = eval "\$strC =~ tr/$uc[$i]/$lc[$j]/$mod[$m];"; $cntM = $mb->strtr(\$strM, $ucP, $lcP, $mod[$m]); ++$NG unless $strC eq str2asc($cs, $strM) && $cntC == $cntM; } } print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n"; } } 1; __END__