5 Class::Accessor::Grouped
8 Class::Accessor::Fast::XS
9 Class::XSAccessor::Compat
16 eval "require $_" or push @missing, $_;
20 die sprintf "Missing modules necessary for benchmark:\n\n%s\n\n",
21 join ("\n", @missing);
27 use Benchmark::Dumb ':all';
30 package Bench::Accessor::GrandParent;
33 use base 'Class::Accessor::Grouped';
34 __PACKAGE__->mk_group_accessors ('inherited', 'cag_inhp');
35 __PACKAGE__->cag_inhp('initial parent value');
37 package Bench::Accessor::Parent;
39 use base 'Bench::Accessor::GrandParent';
41 package Bench::Accessor;
47 use base qw/Bench::Accessor::Parent Class::Accessor::Grouped Class::Accessor::Fast/;
48 use Class::XSAccessor { accessors => [ 'xsa' ] };
51 local $Class::Accessor::Grouped::USE_XS = 0;
52 __PACKAGE__->mk_group_accessors ('simple', 'cag');
55 local $Class::Accessor::Grouped::USE_XS = 1;
56 __PACKAGE__->mk_group_accessors ('simple', 'cag_xs');
59 __PACKAGE__->mk_group_accessors ('inherited', 'cag_inh');
60 __PACKAGE__->cag_inh('initial value');
62 __PACKAGE__->mk_accessors('caf');
65 require Class::Accessor::Fast::XS;
66 local @ISA = 'Class::Accessor::Fast::XS';
67 __PACKAGE__->mk_accessors ('caf_xs');
71 require Class::XSAccessor::Compat;
72 local @ISA = 'Class::XSAccessor::Compat';
73 __PACKAGE__->mk_accessors ('caf_xsa');
79 @_ > 1 ? $_[0]->{handmade} = $_[1] : $_[0]->{handmade};
84 base => bless ({}, 'Bench::Accessor')
88 my ($tasks, $name, $class) = @_;
91 my $gen_class = "Bench::Accessor::$class";
95 has $meth => (is => 'rw');
96 # some moosey thingies can not do this
97 eval { __PACKAGE__->meta->make_immutable };
100 $bench_objs->{$name} = $gen_class->new;
101 _add_task ($tasks, $name, $meth, $name);
105 my ($tasks, $name, $meth, $slot) = @_;
107 # we precompile the desired amount of loops so that the loop itself
108 # does not get in the way with some sort of optimization or whatnot
111 # Dwarn { $meth => $bench_objs->{$slot}->can($meth) };
116 \$::init_val = \$bench_objs->{$slot}->$meth;
117 \$bench_objs->{$slot}->$meth($_);
118 \$bench_objs->{$slot}->$meth(\$bench_objs->{$slot}->$meth + $_);
119 \$bench_objs->{$slot}->$meth(undef);
123 $tasks->{$name} = eval "sub { use warnings; use strict; $perl } " or die $@;
125 # prime things up (have the task run a couple times)
126 $tasks->{$name}->() for (1..5);
131 # $bench_objs->{base}{direct} = 1;
132 # $bench_objs->{base}{direct} = $bench_objs->{base}{direct} + 1;
136 for (qw/CAG CAG_XS CAG_INH CAG_INHP CAF CAF_XS CAF_XSA XSA HANDMADE/) {
137 _add_task ($tasks, $_, lc($_), 'base');
146 for (keys %$moose_based) {
147 _add_moose_task ($tasks, $_, $moose_based->{$_})
152 local $Method::Generate::Accessor::CAN_HAZ_XS = 0;
153 _add_moose_task ($tasks, moo => 'Moo');
156 #delete $tasks->{$_} for grep { $_ !~ /CAG/ } keys %$tasks;
159 print "Perl $], take $_:\n";
160 # DB::enable_profile();
161 cmpthese ( '50.0001', $tasks );
162 # DB::disable_profile();