ext/Encode/t/unibench.pl

   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 $modern = sub {
  41                 Encode::Unicode::set_transcoder("modern");
  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 $classic = sub {
  47                 Encode::Unicode::set_transcoder("classic");
  48                 $meth->('UTF-16BE', $S{$from}{$sz}{$cp})
  49                      eq $S{$to}{$sz}{$cp} or
  50                          die "$op,$from,$to,$sz,$cp";
  51             };
  52             print "---- $op length=$sz/range=$cp ----\n";
  53             my $r = timethese($count,
  54                      {
  55                       "Modern" => $modern,
  56                       "Classic" => $classic,
  57                      },
  58                      'none',
  59                     );
  60             cmpthese($r);
  61         }
  62     }
  63 }