1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
#!/usr/bin/env perl
#
# So you wrote a new mk_hash implementation which passed all tests
# (particularly t/inflate/hri.t) and would like to see how it holds
# up against older (and often buggy) versions of the same. Just run
# this script and wait (no editing necessary)
use warnings;
use strict;
use FindBin;
use lib ("$FindBin::Bin/../../lib", "$FindBin::Bin/../../t/lib");
use Class::Unload '0.07';
use Benchmark ();
use Dumbbench;
use Benchmark::Dumb ':all';
use DBICTest;
# for git reporting to work, and to use it as INC key directly
chdir ("$FindBin::Bin/../../lib");
my $hri_fn = 'DBIx/Class/ResultClass/HashRefInflator.pm';
require Getopt::Long;
my $getopt = Getopt::Long::Parser->new(
config => [qw/gnu_getopt bundling_override no_ignore_case pass_through/]
);
my $args = {
'bench-commits' => 2,
'no-cpufreq-checks' => undef,
};
$getopt->getoptions($args, qw/
bench-commits
no-cpufreq-checks
/);
if (
!$args->{'no-cpufreq-checks'}
and
$^O eq 'linux'
and
-r '/sys/devices/system/cpu/cpu0/cpufreq/scaling_cur_freq'
) {
my ($min_freq, $max_freq, $governor) = map { local @ARGV = $_; my $s = <>; chomp $s; $s } qw|
/sys/devices/system/cpu/cpu0/cpufreq/scaling_min_freq
/sys/devices/system/cpu/cpu0/cpufreq/scaling_max_freq
/sys/devices/system/cpu/cpu0/cpufreq/scaling_governor
|;
if ($min_freq != $max_freq) {
die "Your OS seems to have an active CPU governor '$governor' -"
. ' this will render benchmark results meaningless. Disable it'
. ' by setting /sys/devices/system/cpu/cpu*/cpufreq/scaling_max_freq'
. ' to the same value as /sys/devices/system/cpu/cpu*/cpufreq/scaling_min_freq'
. " ($min_freq). Alternatively skip this check with --no-cpufreq-checks.\n";
}
}
my %skip_commits = map { $_ => 1 } qw/
e1540ee
a5b2936
4613ee1
419ff18
/;
my (@to_bench, $not_latest);
for my $commit (`git log --format=%h HEAD ^8330454^ $hri_fn `) {
chomp $commit;
next if $skip_commits{$commit};
my $diff = `git show -w -U0 --format=%ar%n%b $commit $hri_fn`;
if ($diff =~ /^ (?: \@\@ \s .+? | [+-] sub \s) \$? mk_hash /xm ) {
my ($age) = $diff =~ /\A(.+?)\n/;
push @to_bench, {
commit => $commit,
title => $not_latest ? $commit : 'LATEST',
desc => sprintf ("commit %s (%smade %s)...\t\t",
$commit,
$not_latest ? '' : 'LATEST, ',
$age,
),
code => scalar `git show $commit:lib/DBIx/Class/ResultClass/HashRefInflator.pm`,
};
last if @to_bench == $args->{'bench-commits'};
$not_latest = 1;
}
}
die "Can't find any commits... something is wrong\n" unless @to_bench;
unshift @to_bench, {
desc => "the current uncommitted HRI...\t\t\t\t",
title => 'CURRENT',
code => do { local (@ARGV, $/) = ($hri_fn); <> },
} if `git status --porcelain $hri_fn`;
printf "\nAbout to benchmark %d HRI variants (%s)\n",
scalar @to_bench,
(join ', ', map { $_->{title} } @to_bench),
;
my $schema = DBICTest->init_schema();
# add some extra data for the complex test
$schema->resultset ('Artist')->create({
name => 'largggge',
cds => [
{
genre => { name => 'massive' },
title => 'largesse',
year => 2011,
tracks => [
{
title => 'larguitto',
cd_single => {
title => 'mongo',
year => 2012,
artist => 1,
genre => { name => 'massive' },
tracks => [
{ title => 'yo momma' },
{ title => 'so much momma' },
],
},
},
],
},
],
});
# get what data to feed during benchmarks
{
package _BENCH_::DBIC::InflateResult::Trap;
sub inflate_result { shift; return \@_ }
}
my %bench_dataset = (
simple => do {
my $rs = $schema->resultset ('Artist')->search ({}, {
prefetch => { cds => 'tracks' },
result_class => '_BENCH_::DBIC::InflateResult::Trap',
});
[ $rs->all ];
},
complex => do {
my $rs = $schema->resultset ('Artist')->search ({}, {
prefetch => { cds => [ { tracks => { cd_single => [qw/artist genre tracks/] } }, 'genre' ] },
result_class => '_BENCH_::DBIC::InflateResult::Trap',
});
[ $rs->all ];
},
);
# benchmark coderefs (num iters is set below)
my %num_iters;
my %bench = ( map { $_ => eval "sub {
for (1 .. (\$num_iters{$_}||1) ) {
DBIx::Class::ResultClass::HashRefInflator->inflate_result(\$bench_dataset{$_})
}
}" } qw/simple complex/ );
$|++;
print "\nPre-timing current HRI to determine iteration counts...";
# crude unreliable and quick test how many to run in the loop
# designed to return a value so that there ~ 1/$div runs in a second
# (based on the current @INC implementation)
my $div = 1;
require DBIx::Class::ResultClass::HashRefInflator;
for (qw/simple complex/) {
local $SIG{__WARN__} = sub {};
my $tst = Benchmark::timethis(-1, $bench{$_}, '', 'none');
$num_iters{$_} ||= int( $tst->[5] / $tst->[1] / $div );
$num_iters{$_} ||= 1;
}
print " done\n\nBenchmarking - this can taka a LOOOOOONG time\n\n";
my %results;
for my $bch (@to_bench) {
Class::Unload->unload('DBIx::Class::ResultClass::HashRefInflator');
eval $bch->{code} or die $@;
$INC{'DBIx/Class/ResultClass/HashRefInflator.pm'} = $bch->{title};
for my $t (qw/simple complex/) {
my $label = "Timing $num_iters{$t} $t iterations of $bch->{desc}";
my $bench = Dumbbench->new(
initial_runs => 30,
target_rel_precision => 0.0005,
);
$bench->add_instances( Dumbbench::Instance::PerlSub->new (
name => $label, code => $bench{$t},
));
print $label;
$bench->run;
print(
($results{ (substr $t, 0, 1) . "_$bch->{title}" }
= Benchmark::Dumb->_new( instance => ($bench->instances)[0] ) )
->timestr('')
);
print "\n";
}
}
for my $t (qw/s c/) {
cmpthese ({ map { $_ =~ /^${t}_/ ? ( $_ => $results{$_}) : () } keys %results }, '', '');
}
|
