diff options
Diffstat (limited to 'ext/Encode/t/unibench.pl')
| -rw-r--r-- | ext/Encode/t/unibench.pl | 63 |
1 files changed, 63 insertions, 0 deletions
diff --git a/ext/Encode/t/unibench.pl b/ext/Encode/t/unibench.pl new file mode 100644 index 0000000000..0d8dbf08bc --- /dev/null +++ b/ext/Encode/t/unibench.pl @@ -0,0 +1,63 @@ +#!./perl + +use strict; +use Encode; +use Benchmark qw(:all); + +my $Count = shift @ARGV; +$Count ||= 16; +my @sizes = @ARGV || (1, 4, 16); + +my %utf8_seed; +for my $i (0x00..0xff){ + my $c = chr($i); + $utf8_seed{BMP} .= ($c =~ /^\p{IsPrint}/o) ? $c : " "; +} +utf8::upgrade($utf8_seed{BMP}); + +for my $i (0x00..0xff){ + my $c = chr(0x10000+$i); + $utf8_seed{HIGH} .= ($c =~ /^\p{IsPrint}/o) ? $c : " "; +} +utf8::upgrade($utf8_seed{HIGH}); + +my %S; +for my $i (@sizes){ + my $sz = 256 * $i; + for my $cp (qw(BMP HIGH)){ + $S{utf8}{$sz}{$cp} = $utf8_seed{$cp} x $i; + $S{utf16}{$sz}{$cp} = encode('UTF-16BE', $S{utf8}{$sz}{$cp}); + } +} + +for my $i (@sizes){ + my $sz = $i * 256; + my $count = $Count * int(256/$i); + for my $cp (qw(BMP HIGH)){ + for my $op (qw(encode decode)){ + my ($meth, $from, $to) = ($op eq 'encode') ? + (\&encode, 'utf8', 'utf16') : (\&decode, 'utf16', 'utf8'); + my $modern = sub { + Encode::Unicode::set_transcoder("modern"); + $meth->('UTF-16BE', $S{$from}{$sz}{$cp}) + eq $S{$to}{$sz}{$cp} + or die "$op,$from,$to,$sz,$cp"; + }; + my $classic = sub { + Encode::Unicode::set_transcoder("classic"); + $meth->('UTF-16BE', $S{$from}{$sz}{$cp}) + eq $S{$to}{$sz}{$cp} or + die "$op,$from,$to,$sz,$cp"; + }; + print "---- $op length=$sz/range=$cp ----\n"; + my $r = timethese($count, + { + "Modern" => $modern, + "Classic" => $classic, + }, + 'none', + ); + cmpthese($r); + } + } +} |