1#!perl 2 3BEGIN { $| = 1; print "1..33\n"; } 4END {print "not ok 1\n" unless $loaded;} 5use String::Multibyte; 6$^W = 1; 7$loaded = 1; 8print "ok 1\n"; 9 10# this is a very long test. 11# start from NULL till gets undef... 12 13my $time = time; 14 15%MBCS = ( 16 Big5 => { 17 "last" => "\xFE\xFE", count => 0x80 + 0x7E * 0x9D }, 18 Big5Plus => { 19 "last" => "\xFE\xFE", count => 0x80 + 0x7E * 0xBE }, 20 Bytes => { 21 "last" => "\xFF", count => 0x100 }, 22 EUC => { 23 "last" => "\xFE\xFE", count => 0x80 + 0x5E * 0x5E }, 24 EUC_JP => { 25 "last" => "\x8F\xFE\xFE", count => 0x80 + 0xBD * 0x5E }, 26 EUC_TW => { 27 "last" => "\x8E\xB0\xFE\xFE", count => 0x80 + 0x11 * 0x5E * 0x5E }, 28 GB18030 => { 29 "last" => "\xFE\x39\xFE\x39", 30 count => 0x81 + 0x7E * 0xBE + 0x7E * 0x7E * 100 }, 31 GBK => { 32 "last" => "\xFE\xFE", count => 0x81 + 0x7E * 0xBE }, 33 Johab => { 34 "last" => "\xF9\xFE", count => 0x80 + 0x21 * 0xBC + 11172 + 51 }, 35 ShiftJIS => { 36 "last" => "\xFC\xFC", count => 0x80 + 0x3F + 0x5E * 120 }, 37 UHC => { 38 "last" => "\xFE\xFE", count => 0x80 + 0x45 * 0x5E + 11172 }, 39 UTF16BE => { 40 "last" => "\xDB\xFF\xDF\xFF", count => 0x110000 - 0x800 }, 41 UTF16LE => { 42 "last" => "\xFF\xDB\xFF\xDF", count => 0x110000 - 0x800 }, 43 UTF32BE => { 44 "last" => "\x00\x10\xFF\xFF", count => 0x110000 - 0x800 }, 45 UTF32LE => { 46 "last" => "\xFF\xFF\x10\x00", count => 0x110000 - 0x800 }, 47 UTF8 => { 48 "last" => "\xF4\x8F\xBF\xBF", count => 0x110000 - 0x800 }, 49); 50 51for $name (sort keys %MBCS) { 52 my $mb = String::Multibyte->new($name); 53 my $last = $MBCS{$name}{last}; 54 my $count = $MBCS{$name}{count}; 55 my $c = 0; 56 my $NG = 0; 57 my $ch = 58 $name =~ /UTF32/ ? "\x00\x00\x00\x00" : 59 $name =~ /UTF16/ ? "\x00\x00" : "\x00"; 60 61 use vars qw($re); 62 $] < 5.005 63 ? $re = '^'.$mb->{regexp}.'(?!\n)$' 64 : eval q{ $re = qr/^$mb->{regexp}\z/ }; 65 66 my $nextchar = $mb->{nextchar}; 67 my $cmpchar = $mb->{cmpchar}; 68 while (1) { 69 $c++; 70 # printdeb($name, $ch, "\r") if $c % 256 == 0; 71 72 $NG++ unless $ch =~ /$re/; 73 74 my $next = &$nextchar($ch); 75 $NG++ unless $ch eq $last 76 ? !defined($next) 77 : 0 > &$cmpchar($ch, $next); 78 last if ! defined($next); 79 $ch = $next; 80 } 81 print !$NG ? "ok" : "not ok", " ", ++$loaded, "\n"; 82 print $c == $count ? "ok" : "not ok" , " ", ++$loaded, "\n"; 83} 84 85print "time: ", time - $time, " sec.\n"; 86 87 88sub printdeb { 89# return; 90 print "$_[0] ".unpack('H*', $_[1]).$_[2]; 91} 92 93__END__ 94