+++ /dev/null
-#!/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 }, '', '');
-}
projects / dbsrgits/DBIx-Class.git / blobdiff