3 use warnings FATAL => 'all';
9 # how many times to rerun everything unless -v is supplied
12 my $dumbbench_settings = {
13 target_rel_precision => 0.0003,
15 # no. of guaranteed initial runs
18 # target absolute precision (in s)
19 target_abs_precision => 0,
21 # method for calculating uncertainty
22 variability_measure => 'mad',
24 # no. of "sigma"s for the outlier rejection
25 outlier_rejection => 2,
27 # automatically determined at runtime to not run
28 # longer than $max_bench_duration seconds
29 #max_iterations => xxx
31 # our local addition to Dumbbench
32 max_bench_duration => 20,
33 gettime_clock_id => Time::HiRes::CLOCK_PROCESS_CPUTIME_ID(),
34 code_subiterations => 250,
37 my $acc_name = 'accessor';
38 my $q_acc_name = B::perlstring($acc_name);
42 provider => 'Object::Tiny::RW',
44 Object::Tiny::RW->import($q_acc_name);
49 provider => 'Class::Accessor',
50 type => 'mk_accessors'
54 provider => 'Class::Accessor::Grouped',
57 '$Class::Accessor::Grouped::USE_XS' => 0,
60 __PACKAGE__->mk_group_accessors (simple => $q_acc_name);
65 provider => 'Class::Accessor::Grouped',
68 '$Class::Accessor::Grouped::USE_XS' => 1,
71 __PACKAGE__->mk_group_accessors (simple => $q_acc_name);
76 provider => 'Class::Accessor::Grouped',
79 __PACKAGE__->mk_group_accessors (inherited => $q_acc_name);
80 __PACKAGE__->$acc_name(42);
85 provider => 'Class::Accessor::Grouped',
88 package Bench::Accessor::GrandParent;
89 our \@ISA = 'Class::Accessor::Grouped';
90 __PACKAGE__->mk_group_accessors (inherited => $q_acc_name);
91 __PACKAGE__->$acc_name(42);
93 package Bench::Accessor::Parent;
94 our \@ISA = 'Bench::Accessor::GrandParent';
97 our \@ISA = 'Bench::Accessor::Parent';
102 provider => 'Class::Accessor::Lite',
104 Class::Accessor::Lite->mk_accessors($q_acc_name);
109 provider => 'Class::Accessor::Fast',
110 type => 'mk_accessors'
114 provider => 'Class::Accessor::Fast::XS',
115 type => 'mk_accessors'
119 provider => 'Class::XSAccessor::Compat',
120 type => 'mk_accessors'
124 provider => 'Class::XSAccessor',
126 Class::XSAccessor->import({
127 accessors => [ $q_acc_name ]
137 \@_ > 1 ? \$_[0]->{$q_acc_name} = \$_[1] : \$_[0]->{$q_acc_name};
150 '$Method::Generate::Accessor::CAN_HAZ_XS' => 1,
158 '$Method::Generate::Accessor::CAN_HAZ_XS' => 0,
169 provider => 'Mousse',
180 ##############################
185 my $getopt = Getopt::Long::Parser->new(
186 config => [qw/gnu_getopt bundling_override no_ignore_case pass_through/]
191 $getopt->getoptions($opts, qw/
195 warn "\nIgnoring unrecognized option(s): @ARGV\n\n";
198 my $tasks = _generate_get_set_tasks(
201 iterations => $dumbbench_settings->{code_subiterations},
203 execute => sprintf <<EOS,
204 <SCRATCH> = <OBJECT>->$acc_name;
205 <OBJECT>->$acc_name ( <ITER> );
206 <OBJECT>->$acc_name ( <OBJECT>->$acc_name + <ITER> );
207 <OBJECT>->$acc_name ( undef );
212 #delete $tasks->{$_} for grep { $_ ne 'CAG_S_XS' and $_ ne 'XSA' } keys %$tasks;
213 #delete $tasks->{$_} for grep { $_ =~ /XS/} keys %$tasks;
214 #die _dumper([$tasks, { map { ref($_) => ref($_)->can('accessor') } @::BENCH_objects }] );
216 $bench_cycles = 1 if $opts->{verbose};
218 for (1 .. $bench_cycles) {
219 print "Perl $], take $_:\n";
220 _bench_and_cmp($tasks, $dumbbench_settings, $opts->{verbose});
226 sub _generate_get_set_tasks {
227 my $args = { ref $_[0] ? %{$_[0]} : @_ };
230 my @missing = grep { ! eval "require $_" } (
231 'Dumbbench', map { $_->{provider} || () } values %{$args->{plan}||{}},
234 print STDERR "Missing modules necessary for benchmark:\n\n";
235 print join (' ', (sort @missing), "\n\n");
239 # expand shorthand specs
240 for (values %{$args->{plan}} ) {
242 if ($_->{type} eq 'mooselike') {
243 $_->{has_constructor} = 1;
246 has $acc_name => (is => 'rw');
247 # not all moosey thingies have a finalizer
248 eval { __PACKAGE__->meta->make_immutable };
251 elsif ($_->{type} eq 'mk_accessors') {
254 __PACKAGE__->mk_accessors( $q_acc_name );
258 die "Unknown accessor maker type $_->{type}\n";
263 my $class_counter = 0;
268 my ($name, $plan) = ($_, $args->{plan}{$_});
270 my $class = sprintf 'Bench::Accessor::_%03d', $class_counter;
272 # otherwise the XS-shutoff won't work due to lazy-load
273 require Method::Generate::Accessor
274 if ( $plan->{provider}||'' ) eq 'Moo';
276 unshift @{"${class}::ISA"}, $plan->{provider}
279 my $init_src = <<EOS;
281 use warnings FATAL => 'all';
286 $init_src = "local $_ = $plan->{env}{$_};\n$init_src"
287 for (keys %{$plan->{env}||{}});
289 eval "$init_src; 1" or die "$name initializer failed: $@\n$init_src\n";
291 $::BENCH_objects[$class_counter] = $plan->{has_constructor}
296 my $task_src = join "\n", map {
297 my $exec = $args->{execute};
298 $exec =~ s/<OBJECT>/\$::BENCH_objects[$class_counter]/g;
299 $exec =~ s/<SCRATCH>/\$::BENCH_scratch/g;
300 $exec =~ s/<ITER>/$_/g;
302 } ( 1 .. $args->{iterations} );
304 $task_src = "sub { no warnings; use strict; $task_src }";
305 eval $task_src or die "Unable to compile bench-task for $plan->{provider}: $@\n";
312 provider => $plan->{provider},
313 accessor => $acc_name,
316 } keys %{$args->{plan}} };
320 ##############################
324 use Time::HiRes qw/gettimeofday tv_interval/;
325 use List::Util 'shuffle';
328 #my ($tasks, $db_opts, $verbose) = @_;
331 require Benchmark::Dumb;
334 Benchmark::Dumb::cmpthese ( _bench_tasks(@_) );
338 my ($tasks, $db_opts, $verbose) = @_;
340 my $clr_ln = "\r\x1b[J";
341 my $time_override = eval "sub { Time::HiRes::clock_gettime($db_opts->{gettime_clock_id}) }"
342 or die "Unable to compile Time::HiRes::time override: $@\n";
345 my ($results, $t0, $itertime, $maxiter);
347 my @tnames = shuffle keys %$tasks;
348 for my $i (0..$#tnames) {
351 my $c = eval $tasks->{$tnames[$i]}{src};
353 # fire several times to clear out deferred symtable muckery
355 $c->() for (1..$prerun);
357 # crude timing of an iteration
358 $t0 = [gettimeofday()];
359 $c->() for (1..$prerun);
360 $itertime = tv_interval($t0) / $prerun;
362 $maxiter = int( $db_opts->{max_bench_duration} / $itertime );
363 die "Max iterations $maxiter too low for max runtime $db_opts->{max_bench_duration} ($itertime iter/s)"
366 printf "%s%s: (task %d of %d, pretimed at %.03f/s)%s",
367 $verbose ? "\n" : $clr_ln,
372 $verbose ? "\n" : ' ... ',
375 print( "$n: deparsed accessor: " . _dumper( $tasks->{$n}{class}->can($tasks->{$n}{accessor}) ) )
376 if ($verbose||0) == 2;
378 my $bench = Dumbbench->new(
380 max_iterations => $maxiter,
382 $bench->add_instances(
383 Dumbbench::Instance::PerlSub->new(name => $n, code => $c),
387 no warnings 'redefine';
388 local *Time::HiRes::time = $time_override;
389 $t0 = [gettimeofday()];
392 printf "%s: Elapsed %.03f wall seconds\n", $n, tv_interval($t0);
398 $results->{$n} = Benchmark::Dumb->_new(
399 instance => ($bench->instances)[0]
403 print ($verbose ? "\n" : $clr_ln);
411 require Data::Dumper;
412 Data::Dumper->new([])->Indent(1)->Deparse(1)->Terse(1)->Sortkeys(1)->Quotekeys(0);
413 })->Values([@_])->Dump;