| 1 | #!./perl
|
|---|
| 2 |
|
|---|
| 3 | use strict;
|
|---|
| 4 | use Encode;
|
|---|
| 5 | use Benchmark qw(:all);
|
|---|
| 6 |
|
|---|
| 7 | my $Count = shift @ARGV;
|
|---|
| 8 | $Count ||= 16;
|
|---|
| 9 | my @sizes = @ARGV || (1, 4, 16);
|
|---|
| 10 |
|
|---|
| 11 | my %utf8_seed;
|
|---|
| 12 | for my $i (0x00..0xff){
|
|---|
| 13 | my $c = chr($i);
|
|---|
| 14 | $utf8_seed{BMP} .= ($c =~ /^\p{IsPrint}/o) ? $c : " ";
|
|---|
| 15 | }
|
|---|
| 16 | utf8::upgrade($utf8_seed{BMP});
|
|---|
| 17 |
|
|---|
| 18 | for my $i (0x00..0xff){
|
|---|
| 19 | my $c = chr(0x10000+$i);
|
|---|
| 20 | $utf8_seed{HIGH} .= ($c =~ /^\p{IsPrint}/o) ? $c : " ";
|
|---|
| 21 | }
|
|---|
| 22 | utf8::upgrade($utf8_seed{HIGH});
|
|---|
| 23 |
|
|---|
| 24 | my %S;
|
|---|
| 25 | for 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 |
|
|---|
| 33 | for 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 | }
|
|---|
