|
Packit |
d0f5c2 |
#!./perl
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
use strict;
|
|
Packit |
d0f5c2 |
use Encode;
|
|
Packit |
d0f5c2 |
use Benchmark qw(:all);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $Count = shift @ARGV;
|
|
Packit |
d0f5c2 |
$Count ||= 16;
|
|
Packit |
d0f5c2 |
my @sizes = @ARGV || (1, 4, 16);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my %utf8_seed;
|
|
Packit |
d0f5c2 |
for my $i (0x00..0xff){
|
|
Packit |
d0f5c2 |
my $c = chr($i);
|
|
Packit |
d0f5c2 |
$utf8_seed{BMP} .= ($c =~ /^\p{IsPrint}/o) ? $c : " ";
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
utf8::upgrade($utf8_seed{BMP});
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
for my $i (0x00..0xff){
|
|
Packit |
d0f5c2 |
my $c = chr(0x10000+$i);
|
|
Packit |
d0f5c2 |
$utf8_seed{HIGH} .= ($c =~ /^\p{IsPrint}/o) ? $c : " ";
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
utf8::upgrade($utf8_seed{HIGH});
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my %S;
|
|
Packit |
d0f5c2 |
for my $i (@sizes){
|
|
Packit |
d0f5c2 |
my $sz = 256 * $i;
|
|
Packit |
d0f5c2 |
for my $cp (qw(BMP HIGH)){
|
|
Packit |
d0f5c2 |
$S{utf8}{$sz}{$cp} = $utf8_seed{$cp} x $i;
|
|
Packit |
d0f5c2 |
$S{utf16}{$sz}{$cp} = encode('UTF-16BE', $S{utf8}{$sz}{$cp});
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
for my $i (@sizes){
|
|
Packit |
d0f5c2 |
my $sz = $i * 256;
|
|
Packit |
d0f5c2 |
my $count = $Count * int(256/$i);
|
|
Packit |
d0f5c2 |
for my $cp (qw(BMP HIGH)){
|
|
Packit |
d0f5c2 |
for my $op (qw(encode decode)){
|
|
Packit |
d0f5c2 |
my ($meth, $from, $to) = ($op eq 'encode') ?
|
|
Packit |
d0f5c2 |
(\&encode, 'utf8', 'utf16') : (\&decode, 'utf16', 'utf8');
|
|
Packit |
d0f5c2 |
my $XS = sub {
|
|
Packit |
d0f5c2 |
Encode::Unicode::set_transcoder("xs");
|
|
Packit |
d0f5c2 |
$meth->('UTF-16BE', $S{$from}{$sz}{$cp})
|
|
Packit |
d0f5c2 |
eq $S{$to}{$sz}{$cp}
|
|
Packit |
d0f5c2 |
or die "$op,$from,$to,$sz,$cp";
|
|
Packit |
d0f5c2 |
};
|
|
Packit |
d0f5c2 |
my $modern = sub {
|
|
Packit |
d0f5c2 |
Encode::Unicode::set_transcoder("modern");
|
|
Packit |
d0f5c2 |
$meth->('UTF-16BE', $S{$from}{$sz}{$cp})
|
|
Packit |
d0f5c2 |
eq $S{$to}{$sz}{$cp}
|
|
Packit |
d0f5c2 |
or die "$op,$from,$to,$sz,$cp";
|
|
Packit |
d0f5c2 |
};
|
|
Packit |
d0f5c2 |
my $classic = sub {
|
|
Packit |
d0f5c2 |
Encode::Unicode::set_transcoder("classic");
|
|
Packit |
d0f5c2 |
$meth->('UTF-16BE', $S{$from}{$sz}{$cp})
|
|
Packit |
d0f5c2 |
eq $S{$to}{$sz}{$cp} or
|
|
Packit |
d0f5c2 |
die "$op,$from,$to,$sz,$cp";
|
|
Packit |
d0f5c2 |
};
|
|
Packit |
d0f5c2 |
print "---- $op length=$sz/range=$cp ----\n";
|
|
Packit |
d0f5c2 |
my $r = timethese($count,
|
|
Packit |
d0f5c2 |
{
|
|
Packit |
d0f5c2 |
"XS" => $XS,
|
|
Packit |
d0f5c2 |
"Modern" => $modern,
|
|
Packit |
d0f5c2 |
"Classic" => $classic,
|
|
Packit |
d0f5c2 |
},
|
|
Packit |
d0f5c2 |
'none',
|
|
Packit |
d0f5c2 |
);
|
|
Packit |
d0f5c2 |
cmpthese($r);
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
}
|