BEGIN { $| = 1; print "1..52\n"; } END {print "not ok 1\n" unless $loaded;} use String::Multibyte; $^W = 1; $loaded = 1; print "ok 1\n"; $sjis = String::Multibyte->new('ShiftJIS',1); $euc = String::Multibyte->new('EUC',1); $utf8 = String::Multibyte->new('UTF8',1); print $sjis->substr("\x81\x40\xAD\x40", 1) eq "\xAD\x40" && $euc ->substr("\xA1\xA1\x20\xBD\xBD",2) eq "\xBD\xBD" && $utf8->substr("\xC2\xA0\xEF\xBD\xBF\x60",1,1) eq "\xEF\xBD\xBF" ? "ok" : "not ok", " ", ++$loaded, "\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; } sub undefstr ($) { asc2str(shift, 'undef'); } ##### @ran_char = (0xFF10, 0x2D, 0xFF19, 0xFF21, 0x2D, 0xFF3A, 0xFF41, 0x2D, 0xFF5A); %ran = ( Bytes => "0-9A-Za-z", EUC => "\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA", EUC_JP => "\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA", ShiftJIS => "\x82\x4F-\x82\x58\x82\x60-\x82\x79\x82\x81-\x82\x9A", UTF8 => pack('H*', "efbc902defbc99efbca12defbcbaefbd812defbd9a"), UTF16BE => pack('n*', @ran_char), UTF16LE => pack('v*', @ran_char), UTF32BE => pack('N*', @ran_char), UTF32LE => pack('V*', @ran_char), Unicode => $] < 5.008 ? "" : pack('U*', @ran_char), ); @src_char = (0x30, 0xff11, 0xff12, 0xff13, 0x34, 0x35, 0x36, 0xff17); %src = ( Bytes => '01234567', EUC => pack('H*', '30a3b1a3b2a3b3343536a3b7'), EUC_JP => pack('H*', '30a3b1a3b2a3b3343536a3b7'), ShiftJIS => pack('H*', '308250825182523435368256'), UTF8 => pack('H*', '30efbc91efbc92efbc93343536efbc97'), UTF16BE => pack('n*', @src_char), UTF16LE => pack('v*', @src_char), UTF32BE => pack('N*', @src_char), UTF32LE => pack('V*', @src_char), Unicode => $] < 5.008 ? "" : pack('U*', @src_char), ); %rep = ( Bytes => 'RE', EUC => "\xa3\xd2\xa3\xc5", EUC_JP => "\xa3\xd2\xa3\xc5", ShiftJIS => "\x82\x71\x82\x64", UTF8 => "\xef\xbc\xb2\xef\xbc\xa5", UTF16BE => pack('n*', 0xff32, 0xff25), UTF16LE => pack('v*', 0xff32, 0xff25), UTF32BE => pack('N*', 0xff32, 0xff25), UTF32LE => pack('V*', 0xff32, 0xff25), Unicode => $] < 5.008 ? "" : pack('U*', 0xff32, 0xff25), ); ##### for $cs (qw/Bytes EUC EUC_JP ShiftJIS UTF8 UTF16BE UTF16LE UTF32BE UTF32LE Unicode/) { if ($cs eq 'Unicode' && $] < 5.008) { for (1..5) { print("ok ", ++$loaded, "\n"); } next; } $mb = String::Multibyte->new($cs,1); $alnumZ2H = $mb->trclosure($ran{$cs}, asc2str($cs, $ran{Bytes})); $str = $src{Bytes}; $zen = $src{$cs}; $NG = 0; for $i (-10..10) { next if 5.004 > $] && $i < -8; local $^W = 0; $s = substr($str,$i); $t = $mb->substr($zen,$i); $s = "undef" if ! defined $s; $t = undefstr($cs) if ! defined $t; ++$NG unless $s eq str2asc($cs, &$alnumZ2H($t)); } print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n"; $NG = 0; for $i (-10..10) { next if 5.004 > $] && $i < -8; for $j (undef, -10..10) { local $^W = 0; $s = substr($str,$i,$j); $t = $mb->substr($zen,$i,$j); $s = "undef" if ! defined $s; $t = undefstr($cs) if ! defined $t; ++$NG unless $s eq str2asc($cs, &$alnumZ2H($t)); } } print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n"; $NG = 0; for $i (-8..8) { local $^W = 0; $s = $str; $t = $zen; substr($s,$i) = $rep{Bytes}; ${ $mb->substr(\$t,$i) } = $rep{$cs}; ++$NG unless $s eq str2asc($cs, &$alnumZ2H($t)); } print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n"; $NG = 0; for $i (-8..8) { for $j (undef,-10..10) { local $^W = 0; $s = $str; $t = $zen; substr($s,$i,$j) = $rep{Bytes}; ${ $mb->substr(\$t,$i,$j) } = $rep{$cs}; ++$NG unless $s eq str2asc($cs, &$alnumZ2H($t)); } } print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n"; $NG = 0; for $i (-8..8) { last if 5.005 > $]; for $j (-10..10) { local $^W = 0; $s = $str; $t = $zen; $core = ''; # avoid "used only once" eval q{ $core = substr($s,$i,$j, $rep{Bytes}) }; $mbcs = $mb->substr($t,$i,$j,$rep{$cs}); ++$NG unless $s eq str2asc($cs, &$alnumZ2H($t)); ++$NG unless $core eq str2asc($cs, &$alnumZ2H($mbcs)); } } print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n"; } 1; __END__