1#!./perl 2 3use strict; 4use Encode; 5use Benchmark qw(:all); 6 7my $Count = shift @ARGV; 8$Count ||= 16; 9my @sizes = @ARGV || (1, 4, 16); 10 11my %utf8_seed; 12for my $i (0x00..0xff){ 13 my $c = chr($i); 14 $utf8_seed{BMP} .= ($c =~ /^\p{IsPrint}/o) ? $c : " "; 15} 16utf8::upgrade($utf8_seed{BMP}); 17 18for my $i (0x00..0xff){ 19 my $c = chr(0x10000+$i); 20 $utf8_seed{HIGH} .= ($c =~ /^\p{IsPrint}/o) ? $c : " "; 21} 22utf8::upgrade($utf8_seed{HIGH}); 23 24my %S; 25for my $i (@sizes){ 26 my $sz = 256 * $i; 27 for my $cp (qw(BMP HIGH)){ 28 $S{utf8}{$sz}{$cp} = $utf8_seed{$cp} x $i; 29 $S{utf16}{$sz}{$cp} = encode('UTF-16BE', $S{utf8}{$sz}{$cp}); 30 } 31} 32 33for my $i (@sizes){ 34 my $sz = $i * 256; 35 my $count = $Count * int(256/$i); 36 for my $cp (qw(BMP HIGH)){ 37 for my $op (qw(encode decode)){ 38 my ($meth, $from, $to) = ($op eq 'encode') ? 39 (\&encode, 'utf8', 'utf16') : (\&decode, 'utf16', 'utf8'); 40 my $XS = sub { 41 Encode::Unicode::set_transcoder("xs"); 42 $meth->('UTF-16BE', $S{$from}{$sz}{$cp}) 43 eq $S{$to}{$sz}{$cp} 44 or die "$op,$from,$to,$sz,$cp"; 45 }; 46 my $modern = sub { 47 Encode::Unicode::set_transcoder("modern"); 48 $meth->('UTF-16BE', $S{$from}{$sz}{$cp}) 49 eq $S{$to}{$sz}{$cp} 50 or die "$op,$from,$to,$sz,$cp"; 51 }; 52 my $classic = sub { 53 Encode::Unicode::set_transcoder("classic"); 54 $meth->('UTF-16BE', $S{$from}{$sz}{$cp}) 55 eq $S{$to}{$sz}{$cp} or 56 die "$op,$from,$to,$sz,$cp"; 57 }; 58 print "---- $op length=$sz/range=$cp ----\n"; 59 my $r = timethese($count, 60 { 61 "XS" => $XS, 62 "Modern" => $modern, 63 "Classic" => $classic, 64 }, 65 'none', 66 ); 67 cmpthese($r); 68 } 69 } 70} 71