Silence warnings resulting from incomplete can() overrides hiding

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

diff --git a/benchmark/accessors b/benchmark/accessors
index 16e4f01..0e6cc7f 100644 (file)
--- a/benchmark/accessors
+++ b/benchmark/accessors
@@ -10,6 +10,8 @@ BEGIN {
     Class::XSAccessor::Compat
     Moose
     Mouse
+    Mousse
+    Moo
   /) {
     eval "require $_" or push @missing, $_;
   }
@@ -41,6 +43,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');
 
   {
@@ -73,7 +79,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;
@@ -83,12 +90,19 @@ 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
+
+  my $perl;
+  for (1 .. 1000) {
+    $perl .= "
+      \$::init_val = \$bench_objs->{$slot}->$meth;
+      \$bench_objs->{$slot}->$meth($_);
+      \$bench_objs->{$slot}->$meth(\$bench_objs->{$slot}->$meth + $_);
+    ";
+  }
+
+  $tasks->{$name} = eval "sub { $perl } " or die $@;
 }
 
 my $tasks = {
@@ -98,20 +112,27 @@ my $tasks = {
 #  }
 };
 
-for (qw/CAG CAG_XS CAF CAF_XS CAF_XSA XSA HANDMADE/) {
+for (qw/CAG CAG_XS CAG_INH 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');
+}
 
-for (1, 2) {
+for (1 .. 5) {
   print "Perl $], take $_:\n";
   cmpthese ( -1, $tasks );
   print "\n";