line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Benchmark::DKbench; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
670924
|
use strict; |
|
3
|
|
|
|
|
18
|
|
|
3
|
|
|
|
|
94
|
|
4
|
3
|
|
|
3
|
|
18
|
use warnings; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
78
|
|
5
|
|
|
|
|
|
|
|
6
|
3
|
|
|
3
|
|
17
|
use Config; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
109
|
|
7
|
3
|
|
|
3
|
|
1661
|
use Digest; |
|
3
|
|
|
|
|
1914
|
|
|
3
|
|
|
|
|
114
|
|
8
|
3
|
|
|
3
|
|
24
|
use Digest::MD5 qw(md5_hex); |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
175
|
|
9
|
3
|
|
|
3
|
|
636
|
use Encode; |
|
3
|
|
|
|
|
15804
|
|
|
3
|
|
|
|
|
256
|
|
10
|
3
|
|
|
3
|
|
1588
|
use File::Spec::Functions; |
|
3
|
|
|
|
|
2697
|
|
|
3
|
|
|
|
|
230
|
|
11
|
3
|
|
|
3
|
|
21
|
use List::Util qw(min max sum); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
196
|
|
12
|
3
|
|
|
3
|
|
18
|
use Time::HiRes qw(CLOCK_MONOTONIC); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
27
|
|
13
|
3
|
|
|
3
|
|
3606
|
use Time::Piece; |
|
3
|
|
|
|
|
177226
|
|
|
3
|
|
|
|
|
21
|
|
14
|
|
|
|
|
|
|
|
15
|
3
|
|
|
3
|
|
9255
|
use Astro::Coord::Constellations 'constellation_for_eq'; |
|
3
|
|
|
|
|
65325
|
|
|
3
|
|
|
|
|
206
|
|
16
|
3
|
|
|
3
|
|
32
|
use Astro::Coord::Precession 'precess'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
148
|
|
17
|
3
|
|
|
3
|
|
2474
|
use Crypt::JWT qw(encode_jwt decode_jwt); |
|
3
|
|
|
|
|
173327
|
|
|
3
|
|
|
|
|
245
|
|
18
|
3
|
|
|
3
|
|
1850
|
use CSS::Inliner; |
|
3
|
|
|
|
|
469693
|
|
|
3
|
|
|
|
|
128
|
|
19
|
3
|
|
|
3
|
|
2803
|
use DateTime; |
|
3
|
|
|
|
|
1633411
|
|
|
3
|
|
|
|
|
180
|
|
20
|
3
|
|
|
3
|
|
5196
|
use DBI; |
|
3
|
|
|
|
|
56229
|
|
|
3
|
|
|
|
|
236
|
|
21
|
3
|
|
|
3
|
|
37
|
use File::ShareDir 'dist_dir'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
168
|
|
22
|
3
|
|
|
3
|
|
1713
|
use HTML::FormatText; |
|
3
|
|
|
|
|
21652
|
|
|
3
|
|
|
|
|
112
|
|
23
|
3
|
|
|
3
|
|
27
|
use HTML::TreeBuilder; |
|
3
|
|
|
|
|
38
|
|
|
3
|
|
|
|
|
35
|
|
24
|
3
|
|
|
3
|
|
2963
|
use Imager; |
|
3
|
|
|
|
|
155899
|
|
|
3
|
|
|
|
|
28
|
|
25
|
3
|
|
|
3
|
|
1698
|
use Imager::Filter::Mandelbrot; |
|
3
|
|
|
|
|
1984
|
|
|
3
|
|
|
|
|
115
|
|
26
|
3
|
|
|
3
|
|
1724
|
use Image::PHash; |
|
3
|
|
|
|
|
19317
|
|
|
3
|
|
|
|
|
160
|
|
27
|
3
|
|
|
3
|
|
26
|
use JSON::XS; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
211
|
|
28
|
3
|
|
|
3
|
|
24
|
use Math::DCT ':all'; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
461
|
|
29
|
3
|
|
|
3
|
|
3297
|
use Math::MatrixReal; |
|
3
|
|
|
|
|
91014
|
|
|
3
|
|
|
|
|
211
|
|
30
|
3
|
|
|
3
|
|
1975
|
use MCE::Loop; |
|
3
|
|
|
|
|
153895
|
|
|
3
|
|
|
|
|
47
|
|
31
|
3
|
|
|
3
|
|
3838
|
use SQL::Abstract::Classic; |
|
3
|
|
|
|
|
36855
|
|
|
3
|
|
|
|
|
188
|
|
32
|
3
|
|
|
3
|
|
1867
|
use SQL::Inserter; |
|
3
|
|
|
|
|
6498
|
|
|
3
|
|
|
|
|
156
|
|
33
|
3
|
|
|
3
|
|
1634
|
use System::CPU; |
|
3
|
|
|
|
|
8312
|
|
|
3
|
|
|
|
|
122
|
|
34
|
3
|
|
|
3
|
|
1514
|
use System::Info; |
|
3
|
|
|
|
|
57885
|
|
|
3
|
|
|
|
|
205
|
|
35
|
3
|
|
|
3
|
|
1494
|
use Text::Levenshtein::Damerau::XS; |
|
3
|
|
|
|
|
2066
|
|
|
3
|
|
|
|
|
161
|
|
36
|
3
|
|
|
3
|
|
1356
|
use Text::Levenshtein::XS; |
|
3
|
|
|
|
|
1992
|
|
|
3
|
|
|
|
|
161
|
|
37
|
|
|
|
|
|
|
|
38
|
3
|
|
|
3
|
|
21
|
use Exporter 'import'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
27682
|
|
39
|
|
|
|
|
|
|
our @EXPORT = qw(system_identity suite_run calc_scalability); |
40
|
|
|
|
|
|
|
our $datadir = dist_dir("Benchmark-DKbench"); |
41
|
|
|
|
|
|
|
my $mono_clock = $^O !~ /win/i || $Time::HiRes::VERSION >= 1.9764; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
our $VERSION = '2.3'; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head1 NAME |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
Benchmark::DKbench - Perl CPU Benchmark |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 SYNOPSIS |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# Run the suite single-threaded and then multi-threaded on multi-core systems |
52
|
|
|
|
|
|
|
# Will print scores for the two runs and multi/single thread scalability |
53
|
|
|
|
|
|
|
dkbench |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# A dual-thread "quick" run (with times instead of scores) |
56
|
|
|
|
|
|
|
dkbench -j 2 -q |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# If BioPerl is installed, enable the BioPerl benchmarks by downloading Genbank data |
59
|
|
|
|
|
|
|
dkbench --setup |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# Force install the reference versions of all CPAN modules |
62
|
|
|
|
|
|
|
setup_dkbench --force |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head1 DESCRIPTION |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
A Perl benchmark suite for general compute, created to evaluate the comparative |
67
|
|
|
|
|
|
|
performance of systems when running computationally intensive Perl (both pure Perl |
68
|
|
|
|
|
|
|
and C/XS) workloads. It is a good overall indicator for generic CPU performance in |
69
|
|
|
|
|
|
|
real-world scenarios. It runs single and multi-threaded (able to scale to hundreds |
70
|
|
|
|
|
|
|
of CPUs) and can be fully customized to run the benchmarks that better suit your own |
71
|
|
|
|
|
|
|
scenario. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 INSTALLATION |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
The only non-CPAN software required to install/run the suite is a build environment |
76
|
|
|
|
|
|
|
for the C/XS modules (C compiler, make etc.) and Perl. On the most popular Linux |
77
|
|
|
|
|
|
|
package managers you can easily set up such an environment (as root or with sudo): |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Debian/Ubuntu etc |
80
|
|
|
|
|
|
|
apt-get update |
81
|
|
|
|
|
|
|
apt-get install build-essential perl cpanminus |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# CentOS/Red Hat |
84
|
|
|
|
|
|
|
yum update |
85
|
|
|
|
|
|
|
yum install gcc make patch perl perl-App-cpanminus |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
After that, you can use L<App::cpanminus> to install the benchmark suite (as |
88
|
|
|
|
|
|
|
root/sudo is the easiest, will install for all users): |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
cpanm -n Benchmark::DKbench |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
See the C<setup_dkbench> script below for more on the installation of a couple of |
93
|
|
|
|
|
|
|
optional benchmarks and standardizing your benchmarking environment. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head3 Strawberry Perl |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
If you are on Windows, you should be using the Windows Subsystem for Linux (WSL) |
98
|
|
|
|
|
|
|
for running Perl or, if you can't (e.g. old Windows verions), cygwin instead. |
99
|
|
|
|
|
|
|
The suite should still work on Strawberry Perl, as long as you don't try to run |
100
|
|
|
|
|
|
|
tests when installing (some dependencies will not pass them). The simplest way is |
101
|
|
|
|
|
|
|
with L<App::cpanminus> (most Strawberry Perl verions have it installed): |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
cpanm -n Benchmark::DKbench |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
otherwise with the base CPAN shell: |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
perl -MCPAN -e shell |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
> notest install Benchmark::DKbench |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
and then note that the scripts get the batch extension appended, so C<dkbench.bat> |
112
|
|
|
|
|
|
|
runs the suite (and C<setup_dkbench.bat> can assist with module versions, optional |
113
|
|
|
|
|
|
|
benchmarks etc.). |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Be aware that Strawberry Perl is slower, on my test system I get almost 50% slower |
116
|
|
|
|
|
|
|
performance than WSL and 30% slower than cygwin. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head1 SCRIPTS |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
You will most likely only ever need the main script C<dkbench> which launches the |
121
|
|
|
|
|
|
|
suite, although C<setup_dkbench> can help with setup or standardizing/normalizing your |
122
|
|
|
|
|
|
|
benchmarking environment. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head2 C<dkbench> |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
The main script that runs the DKbench benchmark suite. If L<BioPerl> is installed, |
127
|
|
|
|
|
|
|
you may want to start with C<dkbench --setup>. But beyond that, there are many |
128
|
|
|
|
|
|
|
options to control number of threads, iterations, which benchmarks to run etc: |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
dkbench [options] |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Options: |
133
|
|
|
|
|
|
|
--threads <i>, -j <i> : Number of benchmark threads (default is 1). |
134
|
|
|
|
|
|
|
--multi, -m : Multi-threaded using all your CPU cores/threads. |
135
|
|
|
|
|
|
|
--max_threads <i> : Override the cpu detection to specify max cpu threads. |
136
|
|
|
|
|
|
|
--iter <i>, -i <i> : Number of suite iterations (with min/max/avg at the end). |
137
|
|
|
|
|
|
|
--include <regex> : Run only benchmarks that match regex. |
138
|
|
|
|
|
|
|
--exclude <regex> : Do not run benchmarks that match regex. |
139
|
|
|
|
|
|
|
--time, -t : Report time (sec) instead of score. |
140
|
|
|
|
|
|
|
--quick, -q : Quick benchmark run (implies -t). |
141
|
|
|
|
|
|
|
--no_mce : Do not run under MCE::Loop (implies -j 1). |
142
|
|
|
|
|
|
|
--skip_bio : Skip BioPerl benchmarks. |
143
|
|
|
|
|
|
|
--skip_prove : Skip Moose prove benchmark. |
144
|
|
|
|
|
|
|
--time_piece : Run optional Time::Piece benchmark (see benchmark details). |
145
|
|
|
|
|
|
|
--bio_codons : Run optional BioPerl Codons benchmark (does not scale well). |
146
|
|
|
|
|
|
|
--sleep <i> : Sleep for <i> secs after each benchmark. |
147
|
|
|
|
|
|
|
--setup : Download the Genbank data to enable the BioPerl tests. |
148
|
|
|
|
|
|
|
--datapath <path> : Override the path where the expected benchmark data is found. |
149
|
|
|
|
|
|
|
--ver <num> : Skip benchmarks added after the specified version. |
150
|
|
|
|
|
|
|
--help -h : Show basic help and exit. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
The default run (no options) will run all the benchmarks both single-threaded and |
153
|
|
|
|
|
|
|
multi-threaded (using all detected CPU cores/hyperthreads) and show you scores and |
154
|
|
|
|
|
|
|
multi vs single threaded scalability. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
The scores are calibrated such that a reference CPU (Intel Xeon Platinum 8481C - |
157
|
|
|
|
|
|
|
Sapphire Rapids) would achieve a score of 1000 in a single-core benchmark run using |
158
|
|
|
|
|
|
|
the default software configuration (Linux/Perl 5.36.0 built with multiplicity and |
159
|
|
|
|
|
|
|
threads, with reference CPAN module versions). |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
The multi-thread scalability should approach 100% if each thread runs on a full core |
162
|
|
|
|
|
|
|
(i.e. no SMT), and the core can maintain the clock speed it had on the single-thread |
163
|
|
|
|
|
|
|
runs. Note that the overall scalability is an average of the benchmarks that drops |
164
|
|
|
|
|
|
|
non-scaling outliers (over 2*stdev less than the mean). |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
The suite will report a Pass/Fail per benchmark. A failure may be caused if you have |
167
|
|
|
|
|
|
|
different CPAN module version installed - this is normal, and you will be warned. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
The suite uses L<MCE::Loop> to run on the desired number of parallel threads, although |
170
|
|
|
|
|
|
|
there is an option to disable it, which forces a single-thread run. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=head2 C<setup_dkbench> |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Simple installer to check/get the reference versions of CPAN modules and download |
175
|
|
|
|
|
|
|
the Genbank data file required for the BioPerl benchmarks of the DKbench suite. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
It assumes that you have some software already installed (see INSTALLATION above), |
178
|
|
|
|
|
|
|
try C<setup_dkbench --help> will give you more details. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
setup_dkbench [--force --sudo --test --data=s --help] |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
Options: |
183
|
|
|
|
|
|
|
--sudo : Will use sudo for cpanm calls. |
184
|
|
|
|
|
|
|
--force : Will install reference CPAN module versions and re-download the genbank data. |
185
|
|
|
|
|
|
|
--test : Will run the test suites for the CPAN module (default behaviour is to skip). |
186
|
|
|
|
|
|
|
--data=s : Data dir path to copy files from. Should not need if you installed DKbench. |
187
|
|
|
|
|
|
|
--help : Print this help text and exit. |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Running it without any options will fetch the data for the BioPerl tests (similar to |
190
|
|
|
|
|
|
|
C<dkbench --setup>) and use C<cpanm> to install any missing libraries. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
Using it with C<--force> will install the reference CPAN module versions, including |
193
|
|
|
|
|
|
|
BioPerl which is not a requirement for DKbench, but enables the BioPerl benchmarks. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
The reference Perl and CPAN versions are suggested if you want a fair comparison |
196
|
|
|
|
|
|
|
between systems and also for the benchmark Pass/Fail results to be reliable. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=head1 BENCHMARKS |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
The suite consists of 21 benchmarks, 19 will run by default. However, the |
201
|
|
|
|
|
|
|
C<BioPerl Monomers> requires the optional L<BioPerl> to be installed and Genbank |
202
|
|
|
|
|
|
|
data to be downloaded (C<dkbench --setup> can do the latter), so you will only |
203
|
|
|
|
|
|
|
see 18 benchmarks running just after a standard install. Because the overall score |
204
|
|
|
|
|
|
|
is an average, it is generally unaffected by adding or skipping a benchmark or two. |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
The optional benchmarks are enabled with the C<--time_piece> and C<--bio_codons> |
207
|
|
|
|
|
|
|
options. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=over 4 |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=item * C<Astro> : Calculates precession between random epochs and finds the |
212
|
|
|
|
|
|
|
constellation for random equatorial coordinates using L<Astro::Coord::Precession> |
213
|
|
|
|
|
|
|
and L<Astro::Coord::Constellations> respectively. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=item * C<BioPerl Codons> : Counts codons on a sample bacterial sequence. Requires |
216
|
|
|
|
|
|
|
L<BioPerl> to be installed. |
217
|
|
|
|
|
|
|
This test does not scale well on multiple threads, so is disabled by default (use |
218
|
|
|
|
|
|
|
C<--bio_codons>) option. Requires data fetched using the C<--setup> option. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=item * C<BioPerl Monomers> : Counts monomers on 500 sample bacterial sequences using |
221
|
|
|
|
|
|
|
L<BioPerl> (which needs to be installed). Requires data fetched using the C<--setup> |
222
|
|
|
|
|
|
|
option. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=item * C<CSS::Inliner> : Inlines CSS on 2 sample wiki pages using L<CSS::Inliner>. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item * C<Crypt::JWT> : Creates large JSON Web Tokens with RSA and EC crypto keys |
227
|
|
|
|
|
|
|
using L<Crypt::JWT>. |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=item * C<DateTime> : Creates and manipulates L<DateTime> objects. |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=item * C<DBI/SQL> : Creates a mock L<DBI> connection (using L<DBD::Mock>) and passes |
232
|
|
|
|
|
|
|
it insert/select statements using L<SQL::Inserter> and L<SQL::Abstract::Classic>. |
233
|
|
|
|
|
|
|
The latter is quite slow at creating the statements, but it is widely used. |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=item * C<Digest> : Creates MD5, SH1 and SHA-512 digests of a large string. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=item * C<Encode> : Encodes/decodes large strings from/to UTF-8/16, cp-1252. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=item * C<HTML::FormatText> : Converts HTML to text for 2 sample wiki pages using |
240
|
|
|
|
|
|
|
L<HTML::FormatText>. |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=item * C<Imager> : Loads a sample image and performs edits/manipulations with |
243
|
|
|
|
|
|
|
L<Imager>, including filters like gaussian, unsharp mask, mandelbrot. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=item * C<JSON::XS> : Encodes/decodes random data structures to/from JSON using |
246
|
|
|
|
|
|
|
L<JSON::XS>. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item * C<Math::DCT> : Does 8x8, 18x18 and 32x32 DCT transforms with L<Math::DCT>. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=item * C<Math::MatrixReal> : Performs various manipulations on L<Math::MatrixReal> |
251
|
|
|
|
|
|
|
matrices. |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=item * C<Moose> : Creates L<Moose> objects. |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=item * C<Moose prove> : Runs 110 tests from the Moose 2.2201 test suite. The least |
256
|
|
|
|
|
|
|
CPU-intensive test (which is why there is the option C<--no_prove> to disable it), |
257
|
|
|
|
|
|
|
most of the time will be spent loading the interpreter and the Moose module for each |
258
|
|
|
|
|
|
|
test, which is behaviour representative of how a Perl test suite runs by default. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=item * C<Primes> : Calculates all primes up to 7.5 million. Small number with |
261
|
|
|
|
|
|
|
repeat was chosen to keep low memory (this is a pure Perl function no Math libraries). |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=item * C<Regex/Subst> : Concatenates 3 wiki pages into a byte string then matches |
264
|
|
|
|
|
|
|
3 typical regexes (for names, emails, URIs), replaces html tags with their contents |
265
|
|
|
|
|
|
|
(starting with the innermost) and does calls subst a few times. |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=item * C<Regex/Subst utf8> : Exactly the same as C<Regex/Subst>, but reads into |
268
|
|
|
|
|
|
|
a utf8 string. Perl version can make a big difference, as Unicode behaviour has |
269
|
|
|
|
|
|
|
changed (old Perl versions are faster but less strict in general). |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=item * C<Text::Levenshtein> : The edit distance for strings of various lengths (up |
272
|
|
|
|
|
|
|
to 2500) are calculated using L<Text::Levenshtein::XS> and L<Text::Levenshtein::Damerau::XS>. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=item * C<Time::Piece> : Creates and manipulates/converts Time::Piece objects. It |
275
|
|
|
|
|
|
|
is disabled by default because it uses the OS time libraries, so it might skew results |
276
|
|
|
|
|
|
|
if you are trying to compare CPUs on different OS platforms. It can be enabled with |
277
|
|
|
|
|
|
|
the C<--time_piece> option. For MacOS specifically, it can only be enabled if C<--no_mce> |
278
|
|
|
|
|
|
|
is specified, as it runs extremely slow when forked. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=back |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=head1 EXPORTED FUNCTIONS |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
You will normally not use the Benchmark::DKbench module itself, but here are the |
285
|
|
|
|
|
|
|
exported functions that the C<dkbench> script uses for reference: |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=head2 C<system_identity> |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
my $cores = system_identity(); |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
Prints out software/hardware configuration and returns then number of cores detected. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=head2 C<suite_run> |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
my %stats = suite_run(\%options); |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
Runs the benchmark suite given the C<%options> and prints results. Returns a hash |
298
|
|
|
|
|
|
|
with run stats. |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head2 C<calc_scalability> |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
calc_scalability(\%options, \%stat_single, \%stat_multi); |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Given the C<%stat_single> results of a single-threaded C<suite_run> and C<%stat_multi> |
305
|
|
|
|
|
|
|
results of a multi-threaded run, will calculate and print the multi-thread scalability. |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=head1 NOTES |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
The benchmark suite was created to compare the performance of various cloud offerings. |
310
|
|
|
|
|
|
|
You can see the L<original perl blog post|http://blogs.perl.org/users/dimitrios_kechagias/2022/03/cloud-provider-performance-comparison-gcp-aws-azure-perl.html> |
311
|
|
|
|
|
|
|
as well as the L<2023 follow-up|https://dev.to/dkechag/cloud-vm-performance-value-comparison-2023-perl-more-1kpp>. |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
The benchmarks for the first version were more tuned to what I would expect to run |
314
|
|
|
|
|
|
|
on the servers I was testing, in order to choose the optimal types for the company |
315
|
|
|
|
|
|
|
I was working for. The second version has expanded a bit over that, and is friendlier |
316
|
|
|
|
|
|
|
to use. |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
Althought this benchmark is in general a good indicator of general CPU performance |
319
|
|
|
|
|
|
|
and can be customized to your needs, no benchmark is as good as running your own |
320
|
|
|
|
|
|
|
actual workload. |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=head2 SCORES |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
Some sample DKbench score results from various systems for comparison (all on |
325
|
|
|
|
|
|
|
reference setup with Perl 5.36.0): |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
CPU Cores/HT Single Multi Scalability |
328
|
|
|
|
|
|
|
Intel i7-4750HQ @ 2.0 (MacOS) 4/8 612 2332 46.9% |
329
|
|
|
|
|
|
|
AMD Ryzen 5 PRO 4650U @ 2.1 (WSL) 6/12 905 4444 40.6% |
330
|
|
|
|
|
|
|
Apple M1 Pro @ 3.2 (MacOS) 10/10 1283 10026 78.8% |
331
|
|
|
|
|
|
|
Apple M2 Pro @ 3.5 (MacOS) 12/12 1415 12394 73.1% |
332
|
|
|
|
|
|
|
Ampere Altra @ 3.0 (Linux) 48/48 708 32718 97.7% |
333
|
|
|
|
|
|
|
Intel Xeon Platinum 8481C @ 2.7 (Linux) 88/176 1000 86055 48.9% |
334
|
|
|
|
|
|
|
AMD EPYC Milan 7B13 @ 2.45 (Linux) 112/224 956 104536 49.3% |
335
|
|
|
|
|
|
|
AMD EPYC Genoa 9B14 @ 2.7 (Linux) 180/360 1197 221622 51.4% |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=head1 AUTHOR |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
Dimitrios Kechagias, C<< <dkechag at cpan.org> >> |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=head1 BUGS |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
Please report any bugs or feature requests either on L<GitHub|https://github.com/dkechag/Benchmark-DKbench> (preferred), or on RT (via the email |
344
|
|
|
|
|
|
|
C<bug-Benchmark-DKbench at rt.cpan.org> or L<web interface|https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Benchmark-DKbench>). |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=head1 GIT |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
L<https://github.com/dkechag/Benchmark-DKbench> |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
This software is copyright (c) 2021-2023 by Dimitrios Kechagias. |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
357
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=cut |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
sub benchmark_list { |
362
|
|
|
|
|
|
|
return { # idx : 0 = result, 1 = ref time, 2 = func, 3 = quick test, 4 = normal test, 5 = ver |
363
|
12
|
|
|
12
|
0
|
619
|
'Astro' => ['e71c7ae08f16fe26aea7cfdb72785873', 5.674, \&bench_astro, 20000, 80000], |
364
|
|
|
|
|
|
|
'BioPerl Codons' => ['97c443c099886ca60e99f7ab9df689b5', 8.752, \&bench_bioperl_codons, 3, 5, 1], |
365
|
|
|
|
|
|
|
'BioPerl Monomers' => ['d29ed0a5c205c803c112be1338d1f060', 5.241, \&bench_bioperl_mono, 6, 20], |
366
|
|
|
|
|
|
|
'Crypt::JWT' => ['d41d8cd98f00b204e9800998ecf8427e', 6.451, \&bench_jwt, 250, 900], |
367
|
|
|
|
|
|
|
'CSS::Inliner' => ['82c1b6de9ca0500a48f8a8df0998df3c', 4.603, \&bench_css, 2, 5], |
368
|
|
|
|
|
|
|
'DBI/SQL' => ['2b8252daad9568a5b39038c696df4be3', 5.700, \&bench_dbi, 5000, 15000, 2.1], |
369
|
|
|
|
|
|
|
'DateTime' => ['b08d2eeb994083b7422f6c9d86fed2c6', 6.198, \&bench_datetime, 5000, 15000], |
370
|
|
|
|
|
|
|
'Digest' => ['4b69f6cf0f53cbf6c3444f2f767dd21d', 4.513, \&bench_digest, 50, 250], |
371
|
|
|
|
|
|
|
'Encode' => ['PASS 1025', 5.725, \&bench_encode, 40, 120], |
372
|
|
|
|
|
|
|
'HTML::FormatText' => ['8c2589f0a5276252805e11301fc2ab56', 4.756, \&bench_formattext, 4, 10], |
373
|
|
|
|
|
|
|
'Imager' => ['8829cb3703e884054eb025496f336c63', 6.792, \&bench_imager, 4, 16], |
374
|
|
|
|
|
|
|
'JSON::XS' => ['PASS', 5.388, \&bench_json, 600, 2200], |
375
|
|
|
|
|
|
|
'Math::DCT' => ['766e3bfd7a2276f452bb3d1bd21939bc', 7.147, \&bench_dct, 25000, 100_000], |
376
|
|
|
|
|
|
|
'Math::MatrixReal' => ['4606231b1309fb21ae1223fa0043fd76', 4.293, \&bench_matrixreal, 200, 650], |
377
|
|
|
|
|
|
|
'Moose' => ['d1cb92c513f6378506dfa11f694cffac', 4.968, \&bench_moose, 10_000, 30_000], |
378
|
|
|
|
|
|
|
'Moose prove' => ['PASS', 7.974, \&bench_moose_prv, 0.5, 1], |
379
|
|
|
|
|
|
|
'Primes' => ['4266f70a7a9efb3484cf5d98eba32244', 3.680, \&bench_primes_m, 2, 5], |
380
|
|
|
|
|
|
|
'Regex/Subst' => ['30ce365b25f3d597578b3bdb14aa3f57', 4.652, \&bench_regex_asc, 8, 24], |
381
|
|
|
|
|
|
|
'Regex/Subst utf8' => ['857eb4e63a4d174ca4a16fe678f7626f', 5.703, \&bench_regex_utf8, 3, 10], |
382
|
|
|
|
|
|
|
'Text::Levenshtein' => ['2948a300ed9131fa0ce82bb5eabb8ded', 5.539, \&bench_textlevenshtein, 7, 25, 2.1], |
383
|
|
|
|
|
|
|
'Time::Piece' => ['2d4b149fe7f873a27109fc376d69211b', 5.907, \&bench_timepiece, 75_000, 275_000], |
384
|
|
|
|
|
|
|
}; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
sub system_identity { |
388
|
1
|
|
|
1
|
1
|
1641
|
my ($physical, $cores, $ncpu) = System::CPU::get_cpu; |
389
|
1
|
|
50
|
|
|
2776
|
$ncpu ||= 1; |
390
|
1
|
50
|
|
|
|
6
|
local $^O = 'linux' if $^O =~ /android/; |
391
|
1
|
|
|
|
|
12
|
my $info = System::Info->sysinfo_hash; |
392
|
1
|
|
0
|
|
|
17499
|
my $osn = $info->{distro} || $info->{os} || $^O; |
393
|
1
|
|
50
|
|
|
19
|
my $model = System::CPU::get_name || ''; |
394
|
1
|
|
50
|
|
|
2948
|
my $arch = System::CPU::get_arch || ''; |
395
|
1
|
50
|
|
|
|
8792
|
$arch = " ($arch)" if $arch; |
396
|
1
|
|
|
|
|
33
|
print "--------------- Software ---------------\nDKbench v$VERSION\n"; |
397
|
|
|
|
|
|
|
printf "Perl $^V (%sthreads, %smulti)\n", |
398
|
|
|
|
|
|
|
$Config{usethreads} ? '' : 'no ', |
399
|
1
|
50
|
|
|
|
401
|
$Config{usemultiplicity} ? '' : 'no ',; |
|
|
50
|
|
|
|
|
|
400
|
1
|
|
|
|
|
26
|
print "OS: $osn\n--------------- Hardware ---------------\n"; |
401
|
1
|
|
|
|
|
35
|
print "CPU type: $model$arch\n"; |
402
|
1
|
|
|
|
|
16
|
print "CPUs: $ncpu"; |
403
|
1
|
|
|
|
|
7
|
my @extra; |
404
|
1
|
50
|
33
|
|
|
47
|
push @extra, "$physical Processors" if $physical && $physical > 1; |
405
|
1
|
50
|
|
|
|
33
|
push @extra, "$cores Cores" if $cores; |
406
|
1
|
50
|
33
|
|
|
28
|
push @extra, "$ncpu Threads" if $cores && $cores != $ncpu; |
407
|
1
|
50
|
|
|
|
25
|
print " (".join(', ', @extra).")" if @extra; |
408
|
1
|
|
|
|
|
6
|
print "\n".("-"x40)."\n"; |
409
|
|
|
|
|
|
|
|
410
|
1
|
|
|
|
|
71
|
return $ncpu; |
411
|
|
|
|
|
|
|
}; |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub suite_run { |
414
|
6
|
|
|
6
|
1
|
31006
|
my $opt = shift; |
415
|
6
|
100
|
|
|
|
44
|
$datadir = $opt->{datapath} if $opt->{datapath}; |
416
|
6
|
|
100
|
|
|
92
|
$opt->{threads} //= 1; |
417
|
6
|
|
100
|
|
|
45
|
$opt->{repeat} //= 1; |
418
|
6
|
100
|
|
|
|
47
|
$opt->{f} = $opt->{time} ? '%.3f' : '%5.0f'; |
419
|
6
|
|
|
|
|
28
|
my %stats = (threads => $opt->{threads}); |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
MCE::Loop::init { |
422
|
|
|
|
|
|
|
max_workers => $opt->{threads}, |
423
|
|
|
|
|
|
|
chunk_size => 1, |
424
|
6
|
100
|
|
|
|
50
|
} unless $opt->{no_mce}; |
425
|
|
|
|
|
|
|
|
426
|
6
|
|
|
|
|
87
|
foreach (1..$opt->{iter}) { |
427
|
8
|
100
|
|
|
|
195
|
print "Iteration $_ of $opt->{iter}...\n" if $opt->{iter} > 1; |
428
|
8
|
|
|
|
|
58
|
run_iteration($opt, \%stats); |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
5
|
100
|
|
|
|
53
|
total_stats($opt, \%stats) if $opt->{iter} > 1; |
432
|
|
|
|
|
|
|
|
433
|
5
|
|
|
|
|
710
|
return %stats; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
sub calc_scalability { |
437
|
2
|
|
|
2
|
1
|
5472
|
my ($opt, $stats1, $stats2) = @_; |
438
|
2
|
|
|
|
|
45
|
my $benchmarks = benchmark_list(); |
439
|
2
|
|
|
|
|
18
|
my $threads = $stats2->{threads}/$stats1->{threads}; |
440
|
2
|
100
|
|
|
|
28
|
my $display = $opt->{time} ? 'times' : 'scores'; |
441
|
2
|
100
|
|
|
|
28
|
$opt->{f} = $opt->{time} ? '%.3f' : '%5.0f'; |
442
|
2
|
|
|
|
|
15
|
my (@perf, @scal); |
443
|
2
|
|
|
|
|
19
|
print "Multi thread Scalability:\n".pad_to("Benchmark",24).pad_to("Multi perf xSingle",24).pad_to("Multi scalability %",24); |
444
|
2
|
|
|
|
|
130
|
print "\n"; |
445
|
2
|
|
|
|
|
15
|
my $cnt; |
446
|
2
|
|
|
|
|
46
|
foreach my $bench (sort keys %$benchmarks) { |
447
|
42
|
100
|
100
|
|
|
198
|
next unless $stats1->{$bench}->{times} && $stats2->{$bench}->{times}; |
448
|
2
|
|
|
|
|
17
|
$cnt++; |
449
|
2
|
|
|
|
|
35
|
my @res1 = min_max_avg($stats1->{$bench}->{times}); |
450
|
2
|
|
|
|
|
18
|
my @res2 = min_max_avg($stats2->{$bench}->{times}); |
451
|
2
|
50
|
|
|
|
19
|
push @perf, $res1[2]/$res2[2]*$threads if $res2[2]; |
452
|
2
|
50
|
|
|
|
23
|
push @scal, $res1[2]/$res2[2]*100 if $res2[2]; |
453
|
2
|
|
|
|
|
18
|
print pad_to("$bench:",24).pad_to(sprintf("%.2f",$perf[-1]),24).pad_to(sprintf("%2.0f",$scal[-1]),24)."\n"; |
454
|
|
|
|
|
|
|
} |
455
|
2
|
|
|
|
|
122
|
print (("-"x40)."\n"); |
456
|
2
|
|
|
|
|
26
|
my $avg1 = min_max_avg($stats1->{total}->{$display}); |
457
|
2
|
|
|
|
|
17
|
my $avg2 = min_max_avg($stats2->{total}->{$display}); |
458
|
2
|
|
|
|
|
124
|
print "DKbench summary ($cnt benchmarks, $stats2->{threads} threads):\n"; |
459
|
2
|
|
|
|
|
24
|
print pad_to("Single:").sprintf($opt->{f}, $avg1)."\n"; |
460
|
2
|
|
|
|
|
24
|
print pad_to("Multi:").sprintf($opt->{f}, $avg2)."\n"; |
461
|
2
|
|
|
|
|
29
|
my @newperf = Benchmark::DKbench::drop_outliers(\@perf, -1); |
462
|
2
|
|
|
|
|
18
|
my @newscal = Benchmark::DKbench::drop_outliers(\@scal, -1); |
463
|
2
|
|
|
|
|
19
|
@perf = min_max_avg(\@newperf); |
464
|
2
|
|
|
|
|
16
|
@scal = min_max_avg(\@newscal); |
465
|
2
|
|
|
|
|
13
|
print pad_to("Multi/Single perf:").sprintf("%.2fx\t(%.2f - %.2f)", $perf[2], $perf[0], $perf[1])."\n"; |
466
|
2
|
|
|
|
|
21
|
print pad_to("Multi scalability:").sprintf("%2.1f%% \t(%.0f%% - %.0f%%)", $scal[2], $scal[0], $scal[1])."\n"; |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub run_iteration { |
470
|
8
|
|
|
8
|
0
|
32
|
my ($opt, $stats) = @_; |
471
|
8
|
|
|
|
|
48
|
my $benchmarks = benchmark_list(); |
472
|
8
|
100
|
|
|
|
49
|
my $title = $opt->{time} ? 'Time (sec)' : 'Score'; |
473
|
8
|
|
|
|
|
41
|
print pad_to("Benchmark").pad_to($title); |
474
|
8
|
100
|
|
|
|
106
|
print "Pass/Fail" unless $opt->{time}; |
475
|
8
|
|
|
|
|
99
|
print "\n"; |
476
|
8
|
|
|
|
|
43
|
my ($total_score, $total_time, $i) = (0, 0, 0); |
477
|
8
|
|
|
|
|
119
|
foreach my $bench (sort keys %$benchmarks) { |
478
|
168
|
100
|
100
|
|
|
593
|
next if $opt->{skip_bio} && $bench =~ /Monomers/; |
479
|
166
|
100
|
100
|
|
|
465
|
next if $opt->{skip_prove} && $bench =~ /prove/; |
480
|
164
|
100
|
100
|
|
|
688
|
next if !$opt->{bio_codons} && $bench =~ /Codons/; |
481
|
158
|
100
|
100
|
|
|
546
|
next if !$opt->{time_piece} && $bench =~ /Time::Piece/; |
482
|
152
|
100
|
100
|
|
|
456
|
next if $opt->{ver} && $benchmarks->{$bench}->[5] && $opt->{ver} < $benchmarks->{$bench}->[5]; |
|
|
|
100
|
|
|
|
|
483
|
150
|
100
|
100
|
|
|
577
|
next if $opt->{exclude} && $bench =~ /$opt->{exclude}/; |
484
|
144
|
100
|
100
|
|
|
741
|
next if $opt->{include} && $bench !~ /$opt->{include}/; |
485
|
23
|
50
|
|
|
|
98
|
if ($bench =~ /Bio/) { |
486
|
0
|
|
|
|
|
0
|
require Bio::SeqIO; |
487
|
0
|
|
|
|
|
0
|
require Bio::Tools::SeqStats; |
488
|
|
|
|
|
|
|
} |
489
|
23
|
|
|
|
|
117
|
my ($time, $res) = mce_bench_run($opt, $benchmarks->{$bench}); |
490
|
23
|
|
50
|
|
|
374
|
my $score = int(1000*$opt->{threads}*$benchmarks->{$bench}->[1]/($time || 1)+0.5); |
491
|
23
|
|
|
|
|
79
|
$total_score += $score; |
492
|
23
|
|
|
|
|
61
|
$total_time += $time; |
493
|
23
|
|
|
|
|
44
|
$i++; |
494
|
23
|
|
|
|
|
60
|
push @{$stats->{$bench}->{times}}, $time; |
|
23
|
|
|
|
|
349
|
|
495
|
23
|
|
|
|
|
70
|
push @{$stats->{$bench}->{scores}}, $score; |
|
23
|
|
|
|
|
141
|
|
496
|
23
|
100
|
|
|
|
173
|
my $d = $stats->{$bench}->{$opt->{time} ? 'times' : 'scores'}->[-1]; |
497
|
23
|
100
|
|
|
|
152
|
$stats->{$bench}->{fail}++ if $res ne 'Pass'; |
498
|
23
|
|
|
|
|
196
|
print pad_to("$bench:").pad_to(sprintf($opt->{f}, $d)); |
499
|
23
|
100
|
|
|
|
245
|
print "$res" unless $opt->{time}; |
500
|
23
|
|
|
|
|
286
|
print "\n"; |
501
|
23
|
50
|
|
|
|
207
|
sleep $opt->{sleep} if $opt->{sleep}; |
502
|
|
|
|
|
|
|
} |
503
|
8
|
100
|
|
|
|
280
|
die "No tests to run\n" unless $i; |
504
|
7
|
|
|
|
|
45
|
my $s = int($total_score/$i+0.5); |
505
|
7
|
100
|
|
|
|
51
|
print pad_to("Overall $title: ").sprintf($opt->{f}."\n", $opt->{time} ? $total_time : $s); |
506
|
7
|
|
|
|
|
39
|
push @{$stats->{total}->{times}}, $total_time; |
|
7
|
|
|
|
|
110
|
|
507
|
7
|
|
|
|
|
24
|
push @{$stats->{total}->{scores}}, $s; |
|
7
|
|
|
|
|
770
|
|
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
sub mce_bench_run { |
511
|
23
|
|
|
23
|
0
|
73
|
my $opt = shift; |
512
|
23
|
|
|
|
|
57
|
my $benchmark = shift; |
513
|
23
|
100
|
|
|
|
94
|
$benchmark->[3] = $benchmark->[4] unless $opt->{quick}; |
514
|
23
|
100
|
|
|
|
138
|
return bench_run($benchmark) if $opt->{no_mce}; |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
my @stats = mce_loop { |
517
|
0
|
|
|
0
|
|
0
|
my ($mce, $chunk_ref, $chunk_id) = @_; |
518
|
0
|
|
|
|
|
0
|
for (@{$chunk_ref}) { |
|
0
|
|
|
|
|
0
|
|
519
|
0
|
|
|
|
|
0
|
my ($time, $res) = bench_run($benchmark); |
520
|
0
|
|
|
|
|
0
|
MCE->gather([$time, $res]); |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
} |
523
|
1
|
|
|
|
|
26
|
(1 .. $opt->{threads} * $opt->{repeat}); |
524
|
|
|
|
|
|
|
|
525
|
1
|
|
|
|
|
16639436
|
my ($res, $time) = ('Pass', 0); |
526
|
1
|
|
|
|
|
13
|
foreach (@stats) { |
527
|
2
|
|
|
|
|
19
|
$time += $_->[0]; |
528
|
2
|
50
|
|
|
|
30
|
$res = $_->[1] if $_->[1] ne 'Pass'; |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
1
|
|
50
|
|
|
45
|
return $time/($opt->{threads}*$opt->{repeat} || 1), $res; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
sub bench_run { |
535
|
23
|
|
|
23
|
0
|
186
|
my ($benchmark, $srand) = @_; |
536
|
23
|
|
100
|
|
|
163
|
$srand //= 1; |
537
|
23
|
|
|
|
|
80
|
srand($srand); # For repeatability |
538
|
23
|
|
|
|
|
78
|
my $t0 = _get_time(); |
539
|
23
|
|
|
|
|
267
|
my $out = $benchmark->[2]->($benchmark->[3]); |
540
|
22
|
|
|
|
|
41190
|
my $time = sprintf("%.3f", _get_time()-$t0); |
541
|
22
|
100
|
|
|
|
728
|
my $r = $out eq $benchmark->[0] ? 'Pass' : "Fail ($out)"; |
542
|
22
|
|
|
|
|
260
|
return $time, $r; |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
sub bench_astro { |
546
|
1
|
|
|
1
|
0
|
4
|
my $iter = shift; |
547
|
1
|
|
|
|
|
18
|
my $d = Digest->new("MD5"); |
548
|
|
|
|
|
|
|
my $precessed = precess([rand(24), rand(180)-90], rand(200)+1900, rand(200)+1900) |
549
|
1
|
|
|
|
|
75
|
for (1..$iter*10); |
550
|
1
|
|
|
|
|
10963308
|
my $constellation_abbrev; |
551
|
|
|
|
|
|
|
$d->add(constellation_for_eq(rand(24), rand(180)-90, rand(200)+1900)) |
552
|
1
|
|
|
|
|
22
|
for (1..$iter); |
553
|
1
|
|
|
|
|
7758480
|
return $d->hexdigest; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
sub bench_bioperl_codons { |
557
|
0
|
|
|
0
|
0
|
0
|
my $skip = shift; |
558
|
0
|
|
|
|
|
0
|
my $iter = shift; |
559
|
0
|
|
|
|
|
0
|
my $d = Digest->new("MD5"); |
560
|
0
|
|
|
|
|
0
|
my $file = catfile($datadir, "gbbct5.seq"); |
561
|
0
|
|
|
|
|
0
|
foreach (1..$iter) { |
562
|
0
|
|
|
|
|
0
|
my $in = Bio::SeqIO->new(-file => $file, -format => "genbank"); |
563
|
0
|
|
|
|
|
0
|
$in->next_seq for (1..$skip); |
564
|
0
|
|
|
|
|
0
|
my $seq = $in->next_seq; |
565
|
0
|
|
|
|
|
0
|
my $seq_stats = Bio::Tools::SeqStats->new($seq); |
566
|
0
|
|
|
|
|
0
|
my $codon_ref = $seq_stats->count_codons(); |
567
|
0
|
|
|
|
|
0
|
$d->add($_, $codon_ref->{$_}) for sort keys %$codon_ref; |
568
|
|
|
|
|
|
|
} |
569
|
0
|
|
|
|
|
0
|
return $d->hexdigest; |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
sub bench_bioperl_mono { |
573
|
0
|
|
|
0
|
0
|
0
|
my $iter = shift; |
574
|
0
|
|
|
|
|
0
|
my $file = catfile($datadir, "gbbct5.seq"); |
575
|
0
|
|
|
|
|
0
|
my $in = Bio::SeqIO->new(-file => $file, -format => "genbank"); |
576
|
0
|
|
|
|
|
0
|
my $d = Digest->new("MD5"); |
577
|
0
|
|
|
|
|
0
|
my $builder = $in->sequence_builder(); |
578
|
0
|
|
|
|
|
0
|
$builder->want_none(); |
579
|
0
|
|
|
|
|
0
|
$builder->add_wanted_slot('display_id','seq'); |
580
|
0
|
|
|
|
|
0
|
for (1..$iter) { |
581
|
0
|
|
|
|
|
0
|
my $seq = $in->next_seq; |
582
|
0
|
|
|
|
|
0
|
my $seq_stats = Bio::Tools::SeqStats->new($seq); |
583
|
0
|
|
|
|
|
0
|
my $weight = $seq_stats->get_mol_wt(); |
584
|
0
|
|
|
|
|
0
|
$d->add(int($weight->[0])); |
585
|
0
|
|
|
|
|
0
|
my $monomer_ref = $seq_stats->count_monomers(); |
586
|
0
|
|
|
|
|
0
|
$d->add($_, $monomer_ref->{$_}) for sort keys %$monomer_ref; |
587
|
|
|
|
|
|
|
} |
588
|
0
|
|
|
|
|
0
|
return $d->hexdigest; |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
sub bench_css { |
592
|
1
|
|
|
1
|
0
|
3
|
my $iter = shift; |
593
|
1
|
|
|
|
|
24
|
my $d = Digest->new("MD5"); |
594
|
1
|
|
|
|
|
59
|
my $file; |
595
|
|
|
|
|
|
|
my $html; |
596
|
1
|
|
|
|
|
5
|
for (1..$iter) { |
597
|
2
|
|
|
|
|
3330
|
my $inliner = new CSS::Inliner(); |
598
|
2
|
|
|
|
|
2007
|
my $i = $_ % 2 + 1; |
599
|
2
|
|
|
|
|
32
|
$file = catfile($datadir, "wiki$i.html"); |
600
|
2
|
|
|
|
|
23
|
$inliner->read_file({ filename => $file }); |
601
|
2
|
|
|
|
|
15574189
|
$html = $inliner->inlinify(); |
602
|
2
|
|
|
|
|
16250816
|
$d->add(Encode::encode_utf8($html)); |
603
|
|
|
|
|
|
|
} |
604
|
1
|
|
|
|
|
27279
|
return $d->hexdigest; |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
sub bench_datetime { |
608
|
1
|
|
|
1
|
0
|
9
|
my $iter = shift; |
609
|
1
|
|
|
|
|
1577
|
my @tz = map {DateTime::TimeZone->new( name => $_ )} qw(UTC Europe/London America/New_York); |
|
3
|
|
|
|
|
20107
|
|
610
|
1
|
|
|
|
|
3931
|
my $d = Digest->new("MD5"); |
611
|
1
|
|
|
|
|
34
|
my $str; |
612
|
|
|
|
|
|
|
|
613
|
1
|
|
|
|
|
5
|
for (1..$iter) { |
614
|
5000
|
|
|
|
|
125997
|
my $dt = DateTime->now(); |
615
|
5000
|
|
|
|
|
1292991
|
my $dt1 = DateTime->from_epoch( |
616
|
|
|
|
|
|
|
epoch => 946684800 + rand(100000000), |
617
|
|
|
|
|
|
|
); |
618
|
5000
|
|
|
|
|
1318539
|
my $dt2 = DateTime->from_epoch( |
619
|
|
|
|
|
|
|
epoch => 946684800 + rand(100000000), |
620
|
|
|
|
|
|
|
); |
621
|
5000
|
|
|
|
|
1290072
|
$str = $dt2->strftime('%FT%T')."\n"; |
622
|
5000
|
|
|
|
|
547519
|
$d->add($str); |
623
|
5000
|
|
|
|
|
9472
|
eval {$dt2->set_time_zone($tz[int(rand(3))])}; |
|
5000
|
|
|
|
|
19504
|
|
624
|
5000
|
|
|
|
|
1050769
|
my $dur = $dt2->subtract_datetime($dt1); |
625
|
5000
|
|
|
|
|
5939595
|
eval {$dt2->add_duration($dur)}; |
|
5000
|
|
|
|
|
14601
|
|
626
|
5000
|
|
|
|
|
5891740
|
eval {$dt2->subtract(days => int(rand(1000)+1))}; |
|
5000
|
|
|
|
|
21103
|
|
627
|
5000
|
|
|
|
|
6409479
|
$dt->week; |
628
|
5000
|
|
|
|
|
124642
|
$dt->epoch; |
629
|
5000
|
|
|
|
|
38962
|
$d->add($dt2->strftime('%FT%T')); |
630
|
5000
|
|
|
|
|
571886
|
eval {$dt2->set( year => int(rand(2030)))}; |
|
5000
|
|
|
|
|
20625
|
|
631
|
5000
|
|
|
|
|
3184174
|
$d->add($dt2->ymd('/')); |
632
|
|
|
|
|
|
|
} |
633
|
1
|
|
|
|
|
36
|
return $d->hexdigest; |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
sub bench_dbi { |
637
|
1
|
|
|
1
|
0
|
9
|
my $iter = shift; |
638
|
1
|
|
|
|
|
10
|
my $d = Digest->new("MD5"); |
639
|
1
|
|
|
|
|
103
|
my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); |
640
|
1
|
|
|
|
|
18115
|
my ($data, $cols) = _db_data(); |
641
|
|
|
|
|
|
|
|
642
|
1
|
|
|
|
|
5
|
foreach (1..$iter) { |
643
|
5000
|
|
|
|
|
2257951
|
my $inserter = SQL::Inserter->new( |
644
|
|
|
|
|
|
|
dbh => $dbh, |
645
|
|
|
|
|
|
|
table => 'table', |
646
|
|
|
|
|
|
|
cols => $cols, |
647
|
|
|
|
|
|
|
buffer => 2 |
648
|
|
|
|
|
|
|
); |
649
|
5000
|
|
|
|
|
163177
|
$inserter->insert($data->[int(rand(20))]) for 1..2; |
650
|
5000
|
|
|
|
|
3700499
|
$d->add($dbh->last_insert_id); |
651
|
5000
|
|
|
|
|
55508
|
my $sql = SQL::Abstract::Classic->new(); |
652
|
5000
|
|
|
|
|
234730
|
my ($stmt, @bind) = $sql->insert('table', $data->[int(rand(20))]); |
653
|
5000
|
|
|
|
|
3938862
|
$d->add($dbh->quote($stmt)); |
654
|
5000
|
|
|
|
|
87659
|
($stmt, @bind) = $sql->select('table', $cols->[int(rand(20))], [map {_rand_where()} 1..int(rand(3)+1)]); |
|
10091
|
|
|
|
|
20175
|
|
655
|
5000
|
|
|
|
|
6042552
|
$d->add($dbh->quote($stmt._random_str(5))); |
656
|
5000
|
|
|
|
|
90131
|
my $dbh2 = DBI->connect( 'DBI:Mock:', '', '' ); |
657
|
|
|
|
|
|
|
} |
658
|
1
|
|
|
|
|
521
|
return $d->hexdigest; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
sub bench_dct { |
662
|
2
|
|
|
2
|
0
|
18
|
my $iter = shift; |
663
|
2
|
|
|
|
|
28
|
my $d = Digest->new("MD5"); |
664
|
2
|
|
|
|
|
123
|
$d->add(bench_dct_sz(@$_)) foreach [$iter, 32], [$iter, 18], [$iter*8,8]; |
665
|
|
|
|
|
|
|
|
666
|
2
|
|
|
|
|
38
|
return $d->hexdigest; |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
sub bench_dct_sz { |
670
|
6
|
|
|
6
|
0
|
51
|
my $iter = shift; |
671
|
6
|
|
|
|
|
26
|
my $sz = shift; |
672
|
6
|
|
|
|
|
60
|
my $d = Digest->new("MD5"); |
673
|
6
|
|
|
|
|
315
|
my @arrays; |
674
|
6
|
|
|
|
|
180
|
push @arrays, [map { rand(256) } ( 1..$sz*$sz )] foreach 1..10; |
|
28240
|
|
|
|
|
39896
|
|
675
|
6
|
|
|
|
|
59
|
foreach (1..$iter) { |
676
|
500000
|
|
|
|
|
1035488
|
my $dct = dct2d($arrays[$iter % 10], $sz); |
677
|
500000
|
100
|
|
|
|
16705100
|
$d->add($dct->[0]) if $_ % 10 == 1; |
678
|
|
|
|
|
|
|
} |
679
|
6
|
|
|
|
|
1136
|
return $d->hexdigest; |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
sub bench_digest { |
683
|
1
|
|
|
1
|
0
|
4
|
my $iter = shift; |
684
|
1
|
|
|
|
|
4
|
my $str = _read_wiki_files(); |
685
|
1
|
|
|
|
|
14
|
my $d = Digest->new("MD5"); |
686
|
1
|
|
|
|
|
52
|
my $hex; |
687
|
1
|
|
|
|
|
5
|
foreach (1..$iter) { |
688
|
50
|
|
|
|
|
204
|
my $d2 = Digest->new("MD5"); |
689
|
50
|
|
|
|
|
365696
|
$d2->add($str); |
690
|
50
|
|
|
|
|
443
|
$hex = $d2->hexdigest; |
691
|
50
|
|
|
|
|
167
|
$d->add($hex); |
692
|
50
|
|
|
|
|
176
|
$d2 = Digest->new("SHA-512"); |
693
|
50
|
|
|
|
|
964446
|
$d2->add($str); |
694
|
50
|
|
|
|
|
634
|
$hex = $d2->hexdigest; |
695
|
50
|
|
|
|
|
260
|
$d->add($hex); |
696
|
50
|
|
|
|
|
200
|
$d2 = Digest->new("SHA-1"); |
697
|
50
|
|
|
|
|
566812
|
$d2->add($str); |
698
|
50
|
|
|
|
|
513
|
$hex = $d2->hexdigest; |
699
|
50
|
|
|
|
|
366
|
$d->add($hex); |
700
|
|
|
|
|
|
|
} |
701
|
1
|
|
|
|
|
11
|
return $d->hexdigest; |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
sub bench_encode { |
705
|
1
|
|
|
1
|
0
|
2
|
my $iter = shift; |
706
|
1
|
|
|
|
|
5
|
my $str = _read_wiki_files('utf8'); |
707
|
1
|
|
|
|
|
11
|
my $UTF8 = Encode::find_encoding('UTF-8'); |
708
|
1
|
|
|
|
|
59
|
my $UTF16 = Encode::find_encoding('UTF-16'); |
709
|
1
|
|
|
|
|
3299
|
our $cp1252 = Encode::find_encoding('cp-1252'); |
710
|
1
|
|
|
|
|
368
|
my $res = 'PASS'; |
711
|
1
|
|
|
|
|
4
|
my $unenc = 0; |
712
|
|
|
|
|
|
|
|
713
|
1
|
|
|
|
|
5
|
foreach (1..$iter) { |
714
|
40
|
|
|
|
|
56683
|
my $bytes = encode_utf8($str); |
715
|
40
|
50
|
|
|
|
13296
|
$res = 'Fail' unless length($bytes) > length($str); |
716
|
40
|
|
|
|
|
44130
|
my $cp = decode_utf8($bytes); |
717
|
40
|
100
|
|
|
|
144363
|
my $enc = rand(1) > 0.25 ? $UTF8 : $UTF16; |
718
|
40
|
|
|
|
|
691838
|
$bytes = $enc->encode($cp); |
719
|
40
|
|
|
|
|
421468
|
$cp = $enc->decode($bytes); |
720
|
40
|
50
|
|
|
|
95069
|
$res = 'Fail' unless $cp eq $str; |
721
|
40
|
|
|
|
|
749650
|
my $str2 = $cp1252->encode($cp); |
722
|
40
|
|
|
|
|
1480683
|
$enc->encode($cp1252->decode($str2)); |
723
|
40
|
|
|
|
|
38343
|
$unenc = () = $str2 =~ /\?/g; # Non-encodable |
724
|
|
|
|
|
|
|
} |
725
|
1
|
|
|
|
|
14
|
return "$res $unenc"; |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
sub bench_imager { |
729
|
2
|
|
|
2
|
0
|
150
|
my $iter = shift; |
730
|
2
|
|
|
|
|
91
|
my $d = Digest->new("MD5"); |
731
|
|
|
|
|
|
|
|
732
|
2
|
|
|
|
|
91
|
my $data; |
733
|
2
|
100
|
|
|
|
244
|
open (my $fh, '<:raw', catfile($datadir,'M31.bmp')) or die $!; |
734
|
1
|
|
|
|
|
1572
|
read($fh, $data, -s $fh); |
735
|
1
|
|
|
|
|
18
|
close($fh); |
736
|
|
|
|
|
|
|
|
737
|
1
|
|
|
|
|
7
|
foreach (1..$iter) { |
738
|
4
|
50
|
|
|
|
417431
|
my $img = Imager->new(data=>$data, type=>'bmp') or die Imager->errstr(); |
739
|
4
|
|
|
|
|
81504
|
my $thumb = $img->scale(scalefactor=>.3); |
740
|
4
|
|
|
|
|
236331
|
my $newimg = $img->scale(scalefactor=>1.15); |
741
|
4
|
|
|
|
|
544499
|
$newimg->filter(type=>'autolevels'); |
742
|
4
|
|
|
|
|
58656
|
$newimg->filter(type=>"gaussian", stddev=>0.5); |
743
|
4
|
|
|
|
|
496938
|
$newimg->paste(left=>40,top=>20,img=>$thumb); |
744
|
4
|
|
|
|
|
2276
|
$newimg->rubthrough(src=>$thumb,tx=>30, ty=>50); |
745
|
4
|
|
|
|
|
2245
|
$newimg->compose(src => $thumb, tx => 30, ty => 20, combine => 'color'); |
746
|
4
|
|
|
|
|
28059
|
$newimg->flip(dir=>"h"); |
747
|
4
|
|
|
|
|
29847
|
$newimg->flip(dir=>"vh"); |
748
|
4
|
|
|
|
|
29084
|
$d->add(scalar(Image::PHash->new($newimg)->pHash)); |
749
|
4
|
|
|
|
|
122640
|
$newimg = $img->crop(left=>50, right=>100, top=>10, bottom=>100); |
750
|
4
|
|
|
|
|
1038
|
$newimg = $img->crop(left=>50, top=>10, width=>50, height=>90); |
751
|
4
|
|
|
|
|
571
|
$newimg = $img->copy(); |
752
|
4
|
|
|
|
|
22625
|
$newimg->filter(type=>"unsharpmask", stddev=>1, scale=>0.5); |
753
|
4
|
|
|
|
|
603161
|
$newimg = $img->rotate(degrees=>20); |
754
|
4
|
|
|
|
|
318901
|
$newimg->filter(type=>"contrast", intensity=>1.4); |
755
|
4
|
|
|
|
|
107460
|
$newimg = $img->convert(matrix => [[0, 1, 0], [1, 0, 0], [0, 0, 1]]); |
756
|
4
|
|
|
|
|
38229
|
$newimg = $img->convert(preset=>'grey'); |
757
|
4
|
|
|
|
|
35520
|
$d->add(scalar(Image::PHash->new($newimg)->pHash)); |
758
|
4
|
|
|
|
|
106176
|
$img->filter(type=>'mandelbrot'); |
759
|
|
|
|
|
|
|
} |
760
|
1
|
|
|
|
|
138675
|
return $d->hexdigest; |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
sub bench_json { |
764
|
1
|
|
|
1
|
0
|
3
|
my $iter = shift; |
765
|
1
|
|
|
|
|
4
|
my $res = 'PASS'; |
766
|
1
|
|
|
|
|
5
|
for (1..$iter) { |
767
|
600
|
|
|
|
|
1454
|
my $len = int(rand(40)) + 1; |
768
|
600
|
|
|
|
|
1039
|
my $obj = rand_hash($len); |
769
|
600
|
|
|
|
|
20768
|
my $str = encode_json($obj); |
770
|
600
|
|
|
|
|
1260
|
foreach (1..100) { |
771
|
60000
|
|
|
|
|
2091811
|
$obj = decode_json($str); |
772
|
60000
|
|
|
|
|
1745478
|
$str = encode_json($obj); |
773
|
|
|
|
|
|
|
} |
774
|
600
|
|
|
|
|
19215
|
my $obj2 = decode_json($str); |
775
|
600
|
50
|
|
|
|
1458
|
$res = 'FAIL' unless compare_obj($obj, $obj2); |
776
|
|
|
|
|
|
|
} |
777
|
1
|
|
|
|
|
6
|
return $res; |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
sub bench_jwt { |
781
|
1
|
|
|
1
|
0
|
5
|
my $iter = shift; |
782
|
1
|
|
|
|
|
10
|
my $d = Digest->new("MD5"); |
783
|
1
|
|
|
|
|
60
|
my $data = _random_str(5000); |
784
|
1
|
|
|
|
|
14
|
my $rsa ='-----BEGIN PRIVATE KEY----- |
785
|
|
|
|
|
|
|
MIIBVAIBADANBgkqhkiG9w0BAQEFAASCAT4wggE6AgEAAkEAqPfgaTEWEP3S9w0t |
786
|
|
|
|
|
|
|
gsicURfo+nLW09/0KfOPinhYZ4ouzU+3xC4pSlEp8Ut9FgL0AgqNslNaK34Kq+NZ |
787
|
|
|
|
|
|
|
jO9DAQIDAQABAkAgkuLEHLaqkWhLgNKagSajeobLS3rPT0Agm0f7k55FXVt743hw |
788
|
|
|
|
|
|
|
Ngkp98bMNrzy9AQ1mJGbQZGrpr4c8ZAx3aRNAiEAoxK/MgGeeLui385KJ7ZOYktj |
789
|
|
|
|
|
|
|
hLBNAB69fKwTZFsUNh0CIQEJQRpFCcydunv2bENcN/oBTRw39E8GNv2pIcNxZkcb |
790
|
|
|
|
|
|
|
NQIgbYSzn3Py6AasNj6nEtCfB+i1p3F35TK/87DlPSrmAgkCIQDJLhFoj1gbwRbH |
791
|
|
|
|
|
|
|
/bDRPrtlRUDDx44wHoEhSDRdy77eiQIgE6z/k6I+ChN1LLttwX0galITxmAYrOBh |
792
|
|
|
|
|
|
|
BVl433tgTTQ= |
793
|
|
|
|
|
|
|
-----END PRIVATE KEY-----'; |
794
|
1
|
|
|
|
|
4
|
my $key = '-----BEGIN PRIVATE KEY----- |
795
|
|
|
|
|
|
|
MIGHAgEAMBMGByqGSM49AgEGCCqGSM49AwEHBG0wawIBAQQgYirTZSx+5O8Y6tlG |
796
|
|
|
|
|
|
|
cka6W6btJiocdrdolfcukSoTEk+hRANCAAQkvPNu7Pa1GcsWU4v7ptNfqCJVq8Cx |
797
|
|
|
|
|
|
|
zo0MUVPQgwJ3aJtNM1QMOQUayCrRwfklg+D/rFSUwEUqtZh7fJDiFqz3 |
798
|
|
|
|
|
|
|
-----END PRIVATE KEY-----'; |
799
|
1
|
|
|
|
|
6
|
foreach (1..$iter) { |
800
|
250
|
|
|
|
|
702
|
my $extra = _random_str(100); |
801
|
250
|
|
|
|
|
1087
|
my $data_in = $data.$extra; |
802
|
250
|
|
|
|
|
931
|
my $token = encode_jwt( |
803
|
|
|
|
|
|
|
payload => $data_in, |
804
|
|
|
|
|
|
|
alg => 'ES256', |
805
|
|
|
|
|
|
|
key => \$key, |
806
|
|
|
|
|
|
|
); |
807
|
|
|
|
|
|
|
|
808
|
250
|
|
|
|
|
2193306
|
my $data_out = _decode_jwt2(token=>$token, key=>\$key); |
809
|
250
|
50
|
|
|
|
999
|
$d->add($token) if $data_in eq $data_out.$extra; |
810
|
|
|
|
|
|
|
|
811
|
250
|
|
|
|
|
938
|
$token = encode_jwt( |
812
|
|
|
|
|
|
|
payload => $data_in, |
813
|
|
|
|
|
|
|
alg => 'RS256', |
814
|
|
|
|
|
|
|
key => \$rsa, |
815
|
|
|
|
|
|
|
); |
816
|
|
|
|
|
|
|
|
817
|
250
|
|
|
|
|
211663
|
$data_out = _decode_jwt2(token=>$token, key=>\$rsa); |
818
|
250
|
50
|
|
|
|
1302
|
$d->add($token) if $data_in eq $data_out.$extra; |
819
|
|
|
|
|
|
|
} |
820
|
1
|
|
|
|
|
30
|
return $d->hexdigest; |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
sub bench_formattext { |
824
|
1
|
|
|
1
|
0
|
3
|
my $iter = shift; |
825
|
1
|
|
|
|
|
13
|
my $d = Digest->new("MD5"); |
826
|
1
|
|
|
|
|
54
|
my $file; |
827
|
1
|
|
|
|
|
6
|
for (0..$iter-1) { |
828
|
4
|
|
|
|
|
4513119
|
my $i = $_ % 2; |
829
|
4
|
|
|
|
|
206
|
$file = catfile($datadir, "wiki$i.html"); |
830
|
4
|
|
|
|
|
57
|
my $tree = HTML::TreeBuilder->new->parse_file($file); |
831
|
4
|
|
|
|
|
12502030
|
my $formatter = HTML::FormatText->new(); |
832
|
4
|
|
|
|
|
195
|
my $text = $formatter->format($tree); |
833
|
4
|
|
|
|
|
9551818
|
$formatter = HTML::FormatText->new(leftmargin => 0, rightmargin => 30); |
834
|
4
|
|
|
|
|
14155
|
$d->add(Encode::encode_utf8($formatter->format($tree))); |
835
|
|
|
|
|
|
|
} |
836
|
1
|
|
|
|
|
4091377
|
return $d->hexdigest; |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
sub bench_matrixreal { |
840
|
2
|
|
|
2
|
0
|
13
|
my $iter = shift; |
841
|
2
|
|
|
|
|
55
|
my $d = Digest->new("MD5"); |
842
|
2
|
|
|
|
|
146
|
my $smatrix = Math::MatrixReal->new_random(13); |
843
|
2
|
|
|
|
|
2125
|
my $matrix = Math::MatrixReal->new_random(20); |
844
|
2
|
|
|
|
|
3670
|
my $bmatrix = Math::MatrixReal->new_random(72); |
845
|
|
|
|
|
|
|
|
846
|
2
|
|
|
|
|
40422
|
for (1..$iter) { |
847
|
1300
|
|
|
|
|
11616
|
my $r = rand(10); |
848
|
1300
|
|
|
|
|
6556
|
my $m1 = $r*$bmatrix; |
849
|
1300
|
|
|
|
|
8200906
|
my $m2 = $bmatrix*$r; |
850
|
1300
|
|
|
|
|
8054609
|
my $m3 = $bmatrix->multiply_scalar($bmatrix,$r); |
851
|
|
|
|
|
|
|
# Should be zero |
852
|
1300
|
100
|
|
|
|
7369907
|
$d->add($m1->element(1, 1) + $m2->element(1, 1) - 2 * $bmatrix->element(1, 1)) |
853
|
|
|
|
|
|
|
if $_ % 10 == 1; |
854
|
|
|
|
|
|
|
|
855
|
1300
|
|
|
|
|
12580
|
my $m = $matrix->det; |
856
|
1300
|
100
|
|
|
|
13903032
|
$d->add($m) if $_ % 10 == 1; |
857
|
1300
|
|
|
|
|
5431
|
$m =$matrix->decompose_LR->det_LR; |
858
|
1300
|
100
|
|
|
|
13810596
|
$d->add($m) if $_ % 10 == 1; |
859
|
1300
|
|
|
|
|
6563
|
$m1 = $matrix ** 2; |
860
|
1300
|
|
|
|
|
14693552
|
$m2 = $matrix * $matrix; |
861
|
|
|
|
|
|
|
#should be zero |
862
|
1300
|
100
|
|
|
|
14279018
|
$d->add($m1->element(1, 1) - $m2->element(1, 1)) |
863
|
|
|
|
|
|
|
if $_ % 10 == 1; |
864
|
1300
|
|
|
|
|
10579
|
$m1 = $smatrix->inverse(); |
865
|
1300
|
|
|
|
|
12801282
|
$m2 = $smatrix ** -1; |
866
|
1300
|
|
|
|
|
13185759
|
$m3 = $smatrix->decompose_LR->invert_LR; |
867
|
1300
|
100
|
|
|
|
12726428
|
$d->add($m1->element(1, 1), $m2->element(1, 1), $m3->element(1, 1)) |
868
|
|
|
|
|
|
|
if $_ % 10 == 1; |
869
|
|
|
|
|
|
|
} |
870
|
|
|
|
|
|
|
|
871
|
2
|
|
|
|
|
382
|
return $d->hexdigest; |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
sub bench_moose { |
875
|
1
|
|
|
1
|
0
|
2
|
my $iter = shift; |
876
|
1
|
|
|
|
|
3
|
my $cnt = 0; |
877
|
|
|
|
|
|
|
|
878
|
1
|
|
|
|
|
5
|
for (1..$iter) { |
879
|
10000
|
|
|
|
|
4239428
|
my $p = rand(1000); |
880
|
10000
|
|
|
|
|
37904
|
my $root = Benchmark::DKbench::MooseTree->new(node => 'root'); |
881
|
10000
|
|
|
|
|
11063173
|
$root->price($p); |
882
|
10000
|
|
|
|
|
271405
|
$root->node; |
883
|
10000
|
|
|
|
|
30049
|
$root->cost; |
884
|
10000
|
|
|
|
|
34961
|
my $lchild = $root->left; |
885
|
10000
|
|
|
|
|
280320
|
$lchild->node('child'); |
886
|
10000
|
|
|
|
|
270292
|
$lchild->price($p); |
887
|
10000
|
|
|
|
|
261723
|
$lchild->tax; |
888
|
10000
|
|
|
|
|
31963
|
my $child = $root->right; |
889
|
10000
|
|
|
|
|
28778
|
$child->cost; |
890
|
10000
|
|
|
|
|
33447
|
my $grandchild = $child->left; |
891
|
10000
|
|
|
|
|
280211
|
$grandchild->node('grandchild'); |
892
|
10000
|
|
|
|
|
308198
|
$grandchild->has_parent; |
893
|
10000
|
|
|
|
|
259681
|
$grandchild->parent; |
894
|
10000
|
|
|
|
|
261749
|
$grandchild->price($p); |
895
|
10000
|
|
|
|
|
28898
|
$grandchild->cost; |
896
|
10000
|
|
|
|
|
33496
|
my $ggchild = $grandchild->right; |
897
|
10000
|
|
|
|
|
30710
|
$ggchild->cost; |
898
|
10000
|
|
|
|
|
42858
|
$cnt += 5; |
899
|
|
|
|
|
|
|
} |
900
|
1
|
|
|
|
|
336
|
return md5_hex("$cnt objects"); |
901
|
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
sub bench_moose_prv { |
904
|
2
|
|
|
2
|
0
|
14
|
my $iter = shift; |
905
|
2
|
|
|
|
|
42
|
my $tdir = catfile($datadir, 't'); |
906
|
2
|
|
|
|
|
8
|
my $result; |
907
|
2
|
100
|
|
|
|
12
|
if ($iter < 1) { |
908
|
1
|
|
|
|
|
5
|
$tdir = catfile($tdir, 'recipes'); |
909
|
1
|
|
|
|
|
17686621
|
$result = `prove -rQ $tdir`; |
910
|
|
|
|
|
|
|
} else { |
911
|
1
|
|
|
|
|
76615430
|
$result = `prove -rQ $tdir` for (1..$iter); |
912
|
|
|
|
|
|
|
} |
913
|
2
|
50
|
|
|
|
168
|
if ($result =~ /Result: (\w*)/) { |
914
|
2
|
|
|
|
|
112
|
return $1; |
915
|
|
|
|
|
|
|
} else { |
916
|
0
|
|
|
|
|
0
|
return '?'; |
917
|
|
|
|
|
|
|
} |
918
|
|
|
|
|
|
|
} |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
sub bench_primes_m { |
921
|
1
|
|
|
1
|
0
|
13
|
my $iter = shift; |
922
|
1
|
|
|
|
|
31
|
return bench_primes($iter, 7_500_000); |
923
|
|
|
|
|
|
|
} |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
sub bench_primes { |
926
|
1
|
|
|
1
|
0
|
22
|
my $iter = shift; |
927
|
1
|
|
|
|
|
21
|
my $max = shift; |
928
|
1
|
|
|
|
|
13
|
my @primes; |
929
|
1
|
|
|
|
|
34
|
@primes = _get_primes($max) for (1..$iter); |
930
|
1
|
|
|
|
|
8587
|
return md5_hex(scalar(@primes)." primes up to $max"); |
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
sub bench_regex_asc { |
934
|
1
|
|
|
1
|
0
|
14
|
my $iter = shift; |
935
|
1
|
|
|
|
|
23
|
return bench_regex_subst($iter, ''); |
936
|
|
|
|
|
|
|
} |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
sub bench_regex_utf8 { |
939
|
1
|
|
|
1
|
0
|
5
|
my $iter = shift; |
940
|
1
|
|
|
|
|
16
|
return bench_regex_subst($iter, 'utf8'); |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
sub bench_regex_subst { |
944
|
2
|
|
|
2
|
0
|
19
|
my $iter = shift; |
945
|
2
|
|
|
|
|
19
|
my $enc = shift; |
946
|
2
|
|
|
|
|
20
|
my $str = _read_wiki_files($enc); |
947
|
2
|
|
|
|
|
24
|
my $match = bench_regex($str, $iter); |
948
|
2
|
|
|
|
|
29
|
my $repl = bench_subst($str, $iter); |
949
|
2
|
|
|
|
|
28
|
return md5_hex($match, $repl); |
950
|
|
|
|
|
|
|
} |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
sub bench_regex { |
953
|
2
|
|
|
2
|
0
|
14
|
my $str = shift; |
954
|
2
|
|
|
|
|
8
|
my $iter = shift; |
955
|
2
|
|
|
|
|
9
|
my $count; |
956
|
2
|
|
|
|
|
16
|
for (1..$iter) { |
957
|
11
|
|
|
|
|
103
|
$count = 0; |
958
|
11
|
|
|
|
|
995961
|
$count += () = $str =~ /\b[A-Z][a-z]+/g; |
959
|
11
|
|
|
|
|
1194900
|
$count += () = $str =~ /([\w\.+-]+)@[\w\.-]+\.([\w\.-]+)/g; |
960
|
11
|
|
|
|
|
856917
|
$count += () = $str =~ m![\w]+://[^/\s?#]+[^\s?#]+(?:\?[^\s#]*)?(?:#[^\s]*)?!g; |
961
|
|
|
|
|
|
|
} |
962
|
2
|
|
|
|
|
33
|
return "$count Matched"; |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
sub bench_subst { |
966
|
2
|
|
|
2
|
0
|
7
|
my $str = shift; |
967
|
2
|
|
|
|
|
4
|
my $iter = shift; |
968
|
2
|
|
|
|
|
7
|
my $count; |
969
|
2
|
|
|
|
|
15
|
for (1..$iter) { |
970
|
11
|
|
|
|
|
119
|
my $copy = $str; |
971
|
11
|
|
|
|
|
39
|
$count = 0; |
972
|
11
|
|
|
|
|
788043
|
while (my $s = $copy =~ s#<([^>]+)>([^>]*?)</\1>#$2#g) { |
973
|
44
|
|
|
|
|
2992007
|
$count += $s; |
974
|
|
|
|
|
|
|
} |
975
|
11
|
|
|
|
|
444864
|
$copy = substr($copy, int(rand(100))+1) for 1..10; |
976
|
|
|
|
|
|
|
} |
977
|
2
|
|
|
|
|
19
|
return "$count Replaced"; |
978
|
|
|
|
|
|
|
} |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
sub bench_textlevenshtein { |
981
|
1
|
|
|
1
|
0
|
9
|
my $iter = shift; |
982
|
1
|
|
|
|
|
39
|
my $d = Digest->new("MD5"); |
983
|
1
|
|
|
|
|
81
|
my $data = _fuzzy_data(); |
984
|
1
|
|
|
|
|
6
|
my $diff; |
985
|
1
|
|
|
|
|
10
|
foreach (1..$iter) { |
986
|
7
|
|
|
|
|
34
|
foreach my $sz (qw/10 100 1000 2500/) { |
987
|
28
|
|
|
|
|
65
|
my $n = scalar @{$data->{$sz}}; |
|
28
|
|
|
|
|
107
|
|
988
|
28
|
|
|
|
|
130
|
my $i = int(rand($n)); |
989
|
|
|
|
|
|
|
$diff = Text::Levenshtein::XS::distance( |
990
|
|
|
|
|
|
|
$data->{$sz}->[$i], $data->{$sz}->[$_] |
991
|
28
|
|
|
|
|
164
|
) for 0..$n-1; |
992
|
28
|
|
100
|
|
|
1420435
|
$d->add($diff || -1); |
993
|
28
|
100
|
|
|
|
111
|
next if $sz > 1000; |
994
|
|
|
|
|
|
|
$diff = Text::Levenshtein::Damerau::XS::xs_edistance( |
995
|
|
|
|
|
|
|
$data->{$sz}->[$i], $data->{$sz}->[$_] |
996
|
21
|
|
|
|
|
132
|
) for 0..$n-1; |
997
|
21
|
|
|
|
|
1222593
|
$d->add($diff); |
998
|
|
|
|
|
|
|
} |
999
|
|
|
|
|
|
|
} |
1000
|
1
|
|
|
|
|
103
|
return $d->hexdigest; |
1001
|
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
sub bench_timepiece { |
1004
|
1
|
|
|
1
|
0
|
13
|
my $iter = shift; |
1005
|
1
|
|
|
|
|
23
|
my $t = Time::Piece::localtime(1692119499); |
1006
|
1
|
|
|
|
|
180
|
my $d = Digest->new("MD5"); |
1007
|
1
|
|
|
|
|
97
|
my $day = 3600*24; |
1008
|
1
|
|
|
|
|
27
|
local $ENV{TZ} = 'UTC'; |
1009
|
|
|
|
|
|
|
|
1010
|
1
|
|
|
|
|
9
|
for (1..$iter) { |
1011
|
75000
|
|
|
|
|
249528
|
$t += int(rand(1000)-500)*$day; |
1012
|
75000
|
50
|
|
|
|
1774054
|
$t += 100000*$day if $t->year < 1970; |
1013
|
75000
|
|
|
|
|
373767
|
my $str = $t->strftime("%w, %d %m %Y %H:%M:%S"); |
1014
|
75000
|
|
|
|
|
4223829
|
eval '$t = Time::Piece->strptime($str, "%w, %d %m %Y %H:%M:%S")'; |
1015
|
75000
|
|
|
|
|
1297845
|
my $jd = $t->julian_day; |
1016
|
75000
|
|
|
|
|
4572153
|
$d->add($str,$jd); |
1017
|
|
|
|
|
|
|
} |
1018
|
1
|
|
|
|
|
15
|
return $d->hexdigest; |
1019
|
|
|
|
|
|
|
} |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
sub total_stats { |
1022
|
2
|
|
|
2
|
0
|
23
|
my ($opt, $stats) = @_; |
1023
|
2
|
|
|
|
|
24
|
my $benchmarks = benchmark_list(); |
1024
|
2
|
100
|
|
|
|
37
|
my $display = $opt->{time} ? 'times' : 'scores'; |
1025
|
2
|
100
|
|
|
|
28
|
my $title = $opt->{time} ? 'Time (sec)' : 'Score'; |
1026
|
2
|
|
|
|
|
22
|
print "Aggregates:\n".pad_to("Benchmark",24).pad_to("Avg $title").pad_to("Min $title").pad_to("Max $title"); |
1027
|
2
|
100
|
|
|
|
40
|
print pad_to("Pass %") unless $opt->{time}; |
1028
|
2
|
|
|
|
|
33
|
print "\n"; |
1029
|
2
|
|
|
|
|
51
|
foreach my $bench (sort keys %$benchmarks) { |
1030
|
42
|
100
|
|
|
|
148
|
next unless $stats->{$bench}->{$display}; |
1031
|
2
|
|
|
|
|
31
|
my $str = calc_stats($opt, $stats->{$bench}->{$display}); |
1032
|
2
|
|
|
|
|
26
|
print pad_to("$bench:",24).$str; |
1033
|
|
|
|
|
|
|
print pad_to( |
1034
|
|
|
|
|
|
|
sprintf("%d", 100 * ($opt->{iter}-($stats->{$bench}->{fail} || 0)) / $opt->{iter})) |
1035
|
2
|
100
|
50
|
|
|
46
|
unless $opt->{time}; |
1036
|
2
|
|
|
|
|
37
|
print "\n"; |
1037
|
|
|
|
|
|
|
} |
1038
|
2
|
|
|
|
|
21
|
my $str = calc_stats($opt, $stats->{total}->{$display}); |
1039
|
2
|
|
|
|
|
26
|
print pad_to("Overall Avg $title:", 24)."$str\n"; |
1040
|
|
|
|
|
|
|
} |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
sub calc_stats { |
1043
|
4
|
|
|
4
|
0
|
21
|
my $opt = shift; |
1044
|
4
|
|
|
|
|
21
|
my $arr = shift; |
1045
|
4
|
|
|
|
|
15
|
my $pad = shift; |
1046
|
4
|
|
|
|
|
35
|
my ($min, $max, $avg) = min_max_avg($arr); |
1047
|
4
|
|
|
|
|
19
|
return $avg, join '', map {pad_to(sprintf($opt->{f}, $_), $pad)} ($avg,$min,$max); |
|
12
|
|
|
|
|
77
|
|
1048
|
|
|
|
|
|
|
} |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
sub min_max_avg { |
1051
|
24
|
|
|
24
|
0
|
60
|
my $arr = shift; |
1052
|
24
|
100
|
|
|
|
76
|
return (0, 0, 0) unless @$arr; |
1053
|
23
|
|
|
|
|
153
|
return min(@$arr), max(@$arr), sum(@$arr)/scalar(@$arr); |
1054
|
|
|
|
|
|
|
} |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
sub avg_stdev { |
1057
|
8
|
|
|
8
|
0
|
23
|
my $arr = shift; |
1058
|
8
|
100
|
|
|
|
38
|
return (0, 0) unless @$arr; |
1059
|
7
|
|
|
|
|
35
|
my $sum = sum(@$arr); |
1060
|
7
|
|
|
|
|
25
|
my $avg = $sum/scalar(@$arr); |
1061
|
7
|
|
|
|
|
21
|
my @sq; |
1062
|
7
|
|
|
|
|
69
|
push @sq, ($avg - $_)**2 for (@$arr); |
1063
|
7
|
|
|
|
|
25
|
my $dev = min_max_avg(\@sq); |
1064
|
7
|
|
|
|
|
40
|
return $avg, sqrt($dev); |
1065
|
|
|
|
|
|
|
} |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
# $single = single tail of dist curve outlier, 1 for over (right), -1 for under (left) |
1068
|
|
|
|
|
|
|
sub drop_outliers { |
1069
|
7
|
|
|
7
|
0
|
25
|
my $arr = shift; |
1070
|
7
|
|
|
|
|
36
|
my $single = shift; |
1071
|
7
|
|
|
|
|
28
|
my ($avg, $stdev) = avg_stdev($arr); |
1072
|
7
|
|
|
|
|
18
|
my @newarr; |
1073
|
7
|
|
|
|
|
25
|
foreach (@$arr) { |
1074
|
43
|
100
|
|
|
|
82
|
if ($single) { |
1075
|
30
|
100
|
|
|
|
86
|
push @newarr, $_ unless $single*($_ - $avg) > 2*$stdev; |
1076
|
|
|
|
|
|
|
} else { |
1077
|
13
|
100
|
|
|
|
35
|
push @newarr, $_ unless abs($avg - $_) > 2*$stdev; |
1078
|
|
|
|
|
|
|
} |
1079
|
|
|
|
|
|
|
} |
1080
|
7
|
|
|
|
|
56
|
return @newarr; |
1081
|
|
|
|
|
|
|
} |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
sub pad_to { |
1084
|
115
|
|
|
115
|
0
|
318
|
my $str = shift; |
1085
|
115
|
|
100
|
|
|
471
|
my $len = shift || 20; |
1086
|
115
|
|
|
|
|
3566
|
return $str." "x($len-length($str)); |
1087
|
|
|
|
|
|
|
} |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
sub _read_wiki_files { |
1090
|
4
|
|
100
|
4
|
|
51
|
my $enc = shift || ''; |
1091
|
4
|
|
|
|
|
17
|
my $str = ""; |
1092
|
4
|
|
|
|
|
18
|
for (0..2) { |
1093
|
12
|
50
|
|
|
|
938
|
open my $fh, "<:$enc", catfile($datadir,"wiki$_.html") or die $!; |
1094
|
12
|
|
|
|
|
58
|
$str .= do { local $/; <$fh> }; |
|
12
|
|
|
|
|
68
|
|
|
12
|
|
|
|
|
30535
|
|
1095
|
|
|
|
|
|
|
} |
1096
|
4
|
|
|
|
|
27
|
return $str; |
1097
|
|
|
|
|
|
|
} |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
sub _random_str { |
1100
|
5264
|
|
100
|
5264
|
|
18330
|
my $length = shift || 1; |
1101
|
5264
|
|
|
|
|
8351
|
my $abc = shift; |
1102
|
5264
|
100
|
|
|
|
15791
|
my ($base, $rng) = $abc ? (65, 26) : (32, 95); |
1103
|
5264
|
|
|
|
|
9238
|
my $str = ""; |
1104
|
5264
|
|
|
|
|
40013
|
$str .= chr(int(rand($rng))+$base) for 1..$length; |
1105
|
5264
|
|
|
|
|
43775
|
return $str; |
1106
|
|
|
|
|
|
|
} |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
sub _random_uchar { |
1109
|
46303
|
|
|
46303
|
|
52380
|
my $chr = int(rand(800))+32; |
1110
|
46303
|
100
|
|
|
|
67366
|
$chr += 128 if $chr > 127; # Skip Latin 1 supplement |
1111
|
46303
|
100
|
|
|
|
60543
|
$chr += 288 if $chr > 591; # Skip pre-Greek blocks |
1112
|
46303
|
|
|
|
|
113652
|
return chr($chr); |
1113
|
|
|
|
|
|
|
} |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
sub _fuzzy_data { |
1116
|
1
|
|
|
1
|
|
6
|
my %data; |
1117
|
100
|
|
|
|
|
182
|
push @{$data{10}}, join('', map {_random_uchar()} 1..(8+int(rand(5)))) |
|
996
|
|
|
|
|
1111
|
|
1118
|
1
|
|
|
|
|
6
|
for 0..99; |
1119
|
1
|
|
|
|
|
5
|
push @{$data{100}}, $data{10}->[$_]x10 for 0..49; |
|
50
|
|
|
|
|
137
|
|
1120
|
1
|
|
|
|
|
14
|
push @{$data{1000}}, _random_str(50,1)x20 for 0..7; |
|
8
|
|
|
|
|
26
|
|
1121
|
1
|
|
|
|
|
7
|
push @{$data{2500}}, _random_str(50,1)x50 for 0..3; |
|
4
|
|
|
|
|
143
|
|
1122
|
1
|
|
|
|
|
13
|
return \%data; |
1123
|
|
|
|
|
|
|
} |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
sub _rand_where { |
1126
|
16477
|
|
|
16477
|
|
24729
|
my $p = rand(); |
1127
|
16477
|
100
|
|
|
|
35091
|
if ($p > 0.5) { |
|
|
100
|
|
|
|
|
|
1128
|
8377
|
|
|
|
|
30285
|
return {foo => rand(10)}; |
1129
|
|
|
|
|
|
|
} elsif ($p > 0.2) { |
1130
|
4922
|
|
|
|
|
27500
|
return {bar => {-in => [int($p*10)..int($p*20)]}}; |
1131
|
|
|
|
|
|
|
} else { |
1132
|
3178
|
100
|
|
|
|
6317
|
my $op = $p > 0.1 ? '-and' : '-or'; |
1133
|
3178
|
|
|
|
|
6569
|
my @cond = map {_rand_where()} 1..int(rand(3)+1); |
|
6386
|
|
|
|
|
11300
|
|
1134
|
3178
|
|
|
|
|
12557
|
return {$op => [@cond]}; |
1135
|
|
|
|
|
|
|
} |
1136
|
|
|
|
|
|
|
} |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
sub _db_data { |
1139
|
1
|
|
|
1
|
|
5
|
my (@data, @cols); |
1140
|
1
|
|
|
|
|
5
|
foreach (1..20) { |
1141
|
|
|
|
|
|
|
my $d = { |
1142
|
|
|
|
|
|
|
id => int(rand(10000000)), |
1143
|
|
|
|
|
|
|
date => \"NOW()", |
1144
|
20
|
|
|
|
|
59
|
map {"data".$_ => "foo bar" x int(rand(5)+1)} 1..int(rand(20)+1) |
|
202
|
|
|
|
|
762
|
|
1145
|
|
|
|
|
|
|
}; |
1146
|
20
|
|
|
|
|
64
|
push @data, $d; |
1147
|
20
|
|
|
|
|
168
|
push @cols, [sort keys %$d]; |
1148
|
|
|
|
|
|
|
} |
1149
|
1
|
|
|
|
|
15
|
return \@data, \@cols; |
1150
|
|
|
|
|
|
|
} |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
sub compare_obj { |
1153
|
28701
|
|
|
28701
|
0
|
36120
|
my ($obj1, $obj2) = @_; |
1154
|
28701
|
|
|
|
|
32035
|
my $t1 = ref($obj1); |
1155
|
28701
|
|
|
|
|
29347
|
my $t2 = ref($obj2); |
1156
|
28701
|
100
|
|
|
|
40205
|
return 0 if $t1 ne $t2; |
1157
|
28700
|
100
|
|
|
|
63710
|
return $obj1 eq $obj2 unless $t1; |
1158
|
3496
|
100
|
|
|
|
6693
|
return $t1 eq 'ARRAY' ? compare_arr($obj1, $obj2) : compare_hash($obj1, $obj2); |
1159
|
|
|
|
|
|
|
} |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
sub compare_arr { |
1162
|
1461
|
|
|
1461
|
0
|
2039
|
my ($arr1, $arr2) = @_; |
1163
|
1461
|
|
|
|
|
1878
|
my $sz = scalar @$arr1; |
1164
|
1461
|
100
|
|
|
|
2223
|
return 0 if $sz != scalar @$arr2; |
1165
|
1460
|
|
|
|
|
2636
|
for (0..$sz-1) { |
1166
|
8156
|
100
|
|
|
|
11372
|
return 0 unless compare_obj($arr1->[$_], $arr2->[$_]); |
1167
|
|
|
|
|
|
|
} |
1168
|
1459
|
|
|
|
|
2958
|
return 1; |
1169
|
|
|
|
|
|
|
} |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
sub compare_hash { |
1172
|
2039
|
|
|
2039
|
0
|
3452
|
my ($h1, $h2) = @_; |
1173
|
2039
|
100
|
|
|
|
4624
|
return 0 if scalar keys %$h1 != scalar keys %$h2; |
1174
|
2038
|
|
|
|
|
6351
|
for (keys %$h1) { |
1175
|
19944
|
100
|
|
|
|
28922
|
return 0 unless compare_obj($h1->{$_}, $h2->{$_}); |
1176
|
|
|
|
|
|
|
} |
1177
|
2037
|
|
|
|
|
10902
|
return 1; |
1178
|
|
|
|
|
|
|
} |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
sub rand_arr { |
1181
|
1468
|
|
|
1468
|
0
|
1746
|
my $sz = shift; |
1182
|
1468
|
|
|
|
|
1693
|
my @arr; |
1183
|
1468
|
|
|
|
|
2066
|
for (1..$sz) { |
1184
|
8203
|
|
|
|
|
10186
|
my $len = int(rand(10)) + 1; |
1185
|
8203
|
100
|
|
|
|
13040
|
my $item = rand(1) < 0.9 ? _random_uchar()x($len*5) : rand(1) < 0.5 ? rand_arr($len) : rand_hash($len); |
|
|
100
|
|
|
|
|
|
1186
|
8203
|
|
|
|
|
12778
|
push @arr, $item; |
1187
|
|
|
|
|
|
|
} |
1188
|
1468
|
|
|
|
|
2286
|
return \@arr; |
1189
|
|
|
|
|
|
|
} |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
sub rand_hash { |
1192
|
2044
|
|
|
2044
|
0
|
2488
|
my $sz = shift; |
1193
|
2044
|
|
|
|
|
2335
|
my %hash; |
1194
|
2044
|
|
|
|
|
2977
|
for (1..$sz) { |
1195
|
20008
|
|
|
|
|
27104
|
my $len = int(rand(10)) + 1; |
1196
|
20008
|
100
|
|
|
|
30799
|
my $item = rand(1) < 0.9 ? _random_uchar()x($len*5) : rand(1) < 0.5 ? rand_arr($len) : rand_hash($len); |
|
|
100
|
|
|
|
|
|
1197
|
20008
|
|
|
|
|
27809
|
$hash{_random_uchar()x($len*4)} = $item; |
1198
|
|
|
|
|
|
|
} |
1199
|
2044
|
|
|
|
|
3325
|
return \%hash; |
1200
|
|
|
|
|
|
|
} |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
# modified from https://github.com/famzah/langs-performance/blob/master/primes.pl |
1203
|
|
|
|
|
|
|
sub _get_primes { |
1204
|
2
|
|
|
2
|
|
24
|
my $n = shift; |
1205
|
2
|
|
|
|
|
18
|
my @s = (); |
1206
|
2
|
|
|
|
|
48
|
for (my $i = 3; $i < $n + 1; $i += 2) { |
1207
|
7499998
|
|
|
|
|
12366508
|
push(@s, $i); |
1208
|
|
|
|
|
|
|
} |
1209
|
2
|
|
|
|
|
33
|
my $mroot = $n**0.5; |
1210
|
2
|
|
|
|
|
22
|
my $half = scalar @s; |
1211
|
2
|
|
|
|
|
18
|
my $i = 0; |
1212
|
2
|
|
|
|
|
7
|
my $m = 3; |
1213
|
2
|
|
|
|
|
24
|
while ($m <= $mroot) { |
1214
|
2736
|
100
|
|
|
|
5489
|
if ($s[$i]) { |
1215
|
796
|
|
|
|
|
2472
|
for (my $j = int(($m * $m - 3) / 2); $j < $half; $j += $m) { |
1216
|
13244400
|
|
|
|
|
23374036
|
$s[$j] = 0; |
1217
|
|
|
|
|
|
|
} |
1218
|
|
|
|
|
|
|
} |
1219
|
2736
|
|
|
|
|
3528
|
$i++; |
1220
|
2736
|
|
|
|
|
5502
|
$m = 2 * $i + 3; |
1221
|
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
|
|
1223
|
2
|
|
|
|
|
649379
|
return 2, grep($_, @s); |
1224
|
|
|
|
|
|
|
} |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
# Fix for Crypt::JWT that was submitted as a patch. Will remove if it is merged. |
1227
|
|
|
|
|
|
|
sub _decode_jwt2 { |
1228
|
501
|
|
|
501
|
|
1924
|
my %args = @_; |
1229
|
501
|
|
|
|
|
1078
|
my ($header, $payload); |
1230
|
|
|
|
|
|
|
|
1231
|
501
|
100
|
|
|
|
10134
|
if ($args{token} =~ |
1232
|
|
|
|
|
|
|
/^([a-zA-Z0-9_-]+)=*\.([a-zA-Z0-9_-]*)=*\.([a-zA-Z0-9_-]*)=*(?:\.([a-zA-Z0-9_-]+)=*\.([a-zA-Z0-9_-]+)=*)?$/ |
1233
|
|
|
|
|
|
|
) { |
1234
|
500
|
50
|
|
|
|
1925
|
if (length($5)) { |
1235
|
|
|
|
|
|
|
# JWE token (5 segments) |
1236
|
0
|
|
|
|
|
0
|
($header, $payload) = |
1237
|
|
|
|
|
|
|
Crypt::JWT::_decode_jwe($1, $2, $3, $4, $5, undef, {}, {}, |
1238
|
|
|
|
|
|
|
%args); |
1239
|
|
|
|
|
|
|
} else { |
1240
|
|
|
|
|
|
|
# JWS token (3 segments) |
1241
|
500
|
|
|
|
|
2534
|
($header, $payload) = |
1242
|
|
|
|
|
|
|
Crypt::JWT::_decode_jws($1, $2, $3, {}, %args); |
1243
|
|
|
|
|
|
|
} |
1244
|
|
|
|
|
|
|
} |
1245
|
501
|
100
|
|
|
|
2046969
|
return ($header, $payload) if $args{decode_header}; |
1246
|
500
|
|
|
|
|
2093
|
return $payload; |
1247
|
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
sub _get_time { |
1250
|
45
|
50
|
|
45
|
|
456
|
return $mono_clock ? Time::HiRes::clock_gettime(CLOCK_MONOTONIC) : Time::HiRes::time(); |
1251
|
|
|
|
|
|
|
} |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
# Helper package for Moose benchmark |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
{ |
1256
|
|
|
|
|
|
|
package Benchmark::DKbench::MooseTree; |
1257
|
|
|
|
|
|
|
|
1258
|
3
|
|
|
3
|
|
2047
|
use Moose; |
|
3
|
|
|
|
|
1385969
|
|
|
3
|
|
|
|
|
25
|
|
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
has 'price' => (is => 'rw', default => 10); |
1261
|
|
|
|
|
|
|
has 'tax' => (is => 'rw', lazy_build => 1); |
1262
|
|
|
|
|
|
|
has 'node' => (is => 'rw', isa => 'Any'); |
1263
|
|
|
|
|
|
|
has 'parent' => ( |
1264
|
|
|
|
|
|
|
is => 'rw', |
1265
|
|
|
|
|
|
|
isa => 'Benchmark::DKbench::MooseTree', |
1266
|
|
|
|
|
|
|
predicate => 'has_parent', |
1267
|
|
|
|
|
|
|
weak_ref => 1, |
1268
|
|
|
|
|
|
|
); |
1269
|
|
|
|
|
|
|
has 'left' => ( |
1270
|
|
|
|
|
|
|
is => 'rw', |
1271
|
|
|
|
|
|
|
isa => 'Benchmark::DKbench::MooseTree', |
1272
|
|
|
|
|
|
|
predicate => 'has_left', |
1273
|
|
|
|
|
|
|
lazy => 1, |
1274
|
|
|
|
|
|
|
builder => '_build_child_tree', |
1275
|
|
|
|
|
|
|
); |
1276
|
|
|
|
|
|
|
has 'right' => ( |
1277
|
|
|
|
|
|
|
is => 'rw', |
1278
|
|
|
|
|
|
|
isa => 'Benchmark::DKbench::MooseTree', |
1279
|
|
|
|
|
|
|
predicate => 'has_right', |
1280
|
|
|
|
|
|
|
lazy => 1, |
1281
|
|
|
|
|
|
|
builder => '_build_child_tree', |
1282
|
|
|
|
|
|
|
); |
1283
|
|
|
|
|
|
|
before 'right', 'left' => sub { |
1284
|
|
|
|
|
|
|
my ($self, $tree) = @_; |
1285
|
|
|
|
|
|
|
$tree->parent($self) if defined $tree; |
1286
|
|
|
|
|
|
|
}; |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
sub _build_tax { |
1289
|
50000
|
|
|
50000
|
|
82426
|
my $self = shift; |
1290
|
50000
|
|
|
|
|
1322970
|
$self->price * 0.2; |
1291
|
|
|
|
|
|
|
} |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
sub _build_child_tree { |
1294
|
40000
|
|
|
40000
|
|
66286
|
my $self = shift; |
1295
|
40000
|
|
|
|
|
130618
|
return Benchmark::DKbench::MooseTree->new( parent => $self ); |
1296
|
|
|
|
|
|
|
} |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
sub cost { |
1299
|
40000
|
|
|
40000
|
0
|
72182
|
my $self = shift; |
1300
|
40000
|
|
|
|
|
1072309
|
$self->price + $self->tax; |
1301
|
|
|
|
|
|
|
} |
1302
|
|
|
|
|
|
|
} |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
1; |