examples/Benchmarks/benchmark_hashrefinflator.pl

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