Commit | Line | Data |
f2a2953c |
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'); |
aae85ceb |
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 | }; |
f2a2953c |
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 | { |
aae85ceb |
61 | "XS" => $XS, |
62 | "Modern" => $modern, |
f2a2953c |
63 | "Classic" => $classic, |
64 | }, |
65 | 'none', |
66 | ); |
67 | cmpthese($r); |
68 | } |
69 | } |
70 | } |