BEGIN { my @missing; for (qw/ strictures Class::Accessor::Grouped Class::XSAccessor Class::Accessor::Fast Class::Accessor::Fast::XS Class::XSAccessor::Compat Moose Mouse Mousse Moo Dumbbench /) { eval "require $_" or push @missing, $_; } if (@missing) { die sprintf "Missing modules necessary for benchmark:\n\n%s\n\n", join ("\n", @missing); } } use strictures 1; use Benchmark::Dumb ':all'; { package Bench::Accessor::GrandParent; use strictures 1; use base 'Class::Accessor::Grouped'; __PACKAGE__->mk_group_accessors ('inherited', 'cag_inhp'); __PACKAGE__->cag_inhp('initial parent value'); package Bench::Accessor::Parent; use strictures 1; use base 'Bench::Accessor::GrandParent'; package Bench::Accessor; use strictures 1; our @ISA; use base qw/Bench::Accessor::Parent Class::Accessor::Grouped Class::Accessor::Fast/; use Class::XSAccessor { accessors => [ 'xsa' ] }; { local $Class::Accessor::Grouped::USE_XS = 0; __PACKAGE__->mk_group_accessors ('simple', 'cag'); } { local $Class::Accessor::Grouped::USE_XS = 1; __PACKAGE__->mk_group_accessors ('simple', 'cag_xs'); } __PACKAGE__->mk_group_accessors ('inherited', 'cag_inh'); __PACKAGE__->cag_inh('initial value'); __PACKAGE__->mk_accessors('caf'); { require Class::Accessor::Fast::XS; local @ISA = 'Class::Accessor::Fast::XS'; __PACKAGE__->mk_accessors ('caf_xs'); } { require Class::XSAccessor::Compat; local @ISA = 'Class::XSAccessor::Compat'; __PACKAGE__->mk_accessors ('caf_xsa'); } sub handmade { no warnings; no strict; @_ > 1 ? $_[0]->{handmade} = $_[1] : $_[0]->{handmade}; } } my $bench_objs = { base => bless ({}, 'Bench::Accessor') }; sub _add_moose_task { my ($tasks, $name, $class) = @_; my $meth = lc($name); my $gen_class = "Bench::Accessor::$class"; eval <<"EOC"; package $gen_class; use $class; has $meth => (is => 'rw'); # some moosey thingies can not do this eval { __PACKAGE__->meta->make_immutable }; EOC $bench_objs->{$name} = $gen_class->new; _add_task ($tasks, $name, $meth, $name); } sub _add_task { my ($tasks, $name, $meth, $slot) = @_; # we precompile the desired amount of loops so that the loop itself # does not get in the way with some sort of optimization or whatnot use Devel::Dwarn; # Dwarn { $meth => $bench_objs->{$slot}->can($meth) }; my $perl; for (1 .. 100) { $perl .= " \$::init_val = \$bench_objs->{$slot}->$meth; \$bench_objs->{$slot}->$meth($_); \$bench_objs->{$slot}->$meth(\$bench_objs->{$slot}->$meth + $_); \$bench_objs->{$slot}->$meth(undef); "; } $tasks->{$name} = eval "sub { use warnings; use strict; $perl } " or die $@; # prime things up (have the task run a couple times) $tasks->{$name}->() for (1..5); } my $tasks = { # 'direct' => sub { # $bench_objs->{base}{direct} = 1; # $bench_objs->{base}{direct} = $bench_objs->{base}{direct} + 1; # } }; for (qw/CAG CAG_XS CAG_INH CAG_INHP CAF CAF_XS CAF_XSA XSA HANDMADE/) { _add_task ($tasks, $_, lc($_), 'base'); } my $moose_based = { moOse => 'Moose', moo_XS => 'Moo', moUse_XS => 'Mouse', moUse => 'Mousse', }; for (keys %$moose_based) { _add_moose_task ($tasks, $_, $moose_based->{$_}) } { no warnings 'once'; local $Method::Generate::Accessor::CAN_HAZ_XS = 0; _add_moose_task ($tasks, moo => 'Moo'); } #delete $tasks->{$_} for grep { $_ !~ /CAG/ } keys %$tasks; for (1 .. 3) { print "Perl $], take $_:\n"; # DB::enable_profile(); cmpthese ( '50.0001', $tasks ); # DB::disable_profile(); print "\n"; }