The complexity of caching pkg_gen is in fact making things slower

[p5sagit/Class-Accessor-Grouped.git] / benchmark / accessors

diff --git a/benchmark/accessors b/benchmark/accessors
index 74716b2..e28eba1 100644 (file)
--- a/benchmark/accessors
+++ b/benchmark/accessors
@@ -1,14 +1,17 @@
-use strictures 1;
-
 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, $_;
   }
@@ -20,16 +23,28 @@ BEGIN {
 }
 
 
-use Benchmark qw/:hireswallclock cmpthese/;
+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/Class::Accessor::Grouped Class::Accessor::Fast/;
+  use base qw/Bench::Accessor::Parent Class::Accessor::Grouped Class::Accessor::Fast/;
   use Class::XSAccessor { accessors => [ 'xsa' ] };
 
   {
@@ -40,6 +55,10 @@ use Benchmark qw/:hireswallclock cmpthese/;
     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');
 
   {
@@ -48,7 +67,15 @@ use Benchmark qw/:hireswallclock cmpthese/;
     __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};
   }
 
@@ -66,7 +93,8 @@ sub _add_moose_task {
 package $gen_class;
 use $class;
 has $meth => (is => 'rw');
-__PACKAGE__->meta->make_immutable;
+# some moosey thingies can not do this
+eval { __PACKAGE__->meta->make_immutable };
 EOC
 
   $bench_objs->{$name} = $gen_class->new;
@@ -76,12 +104,26 @@ EOC
 sub _add_task {
   my ($tasks, $name, $meth, $slot) = @_;
 
-  $tasks->{$name} = eval "sub {
-    for (my \$i = 0; \$i < 100; \$i++) {
-      \$bench_objs->{$slot}->$meth(1);
-      \$bench_objs->{$slot}->$meth(\$bench_objs->{$slot}->$meth + 1);
-    }
-  }";
+  # 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 = {
@@ -91,21 +133,32 @@ my $tasks = {
 #  }
 };
 
-for (qw/CAG CAG_XS CAF CAF_XS XSA HANDMADE/) {
+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',
-  ($ENV{MOUSE_PUREPERL} ? 'moUse' : 'moUse_XS') => 'Mouse',
+  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, 2) {
+for (1 .. 3) {
   print "Perl $], take $_:\n";
-  cmpthese ( -1, $tasks );
+#  DB::enable_profile();
+  cmpthese ( '50.0001', $tasks );
+#  DB::disable_profile();
   print "\n";
 }