Refactor object benchmarks even more

[gitmo/Moo.git] / benchmark / object_factory

diff --git a/benchmark/object_factory b/benchmark/object_factory
index 942eb46..14b0c40 100644 (file)
--- a/benchmark/object_factory
+++ b/benchmark/object_factory
@@ -18,14 +18,13 @@ BEGIN {
     { getopt_conf => [qw/gnu_getopt bundling_override no_ignore_case/] },
   );
 
-  # can not change this runtime, thus in-block
-  $ENV{MOUSE_PUREPERL} = 1 if $opts->{bench} eq 'pp';
-
   my @missing;
   for (qw/
     Moose
     Moo
     Mouse
+    Mousse
+    Class::XSAccessor
   /) {
     eval "require $_" or push @missing, $_;
   }
@@ -55,17 +54,17 @@ if ($opts->{bench} =~ /all|pp/) {
   }
 
   _add_moosey_has (moose => 'Moose');
-  _add_moosey_has (mouse => 'Mouse')
-    if $ENV{MOUSE_PUREPERL};
+  _add_moosey_has (mouse => 'Mousse')
 }
 
 if ($opts->{bench} =~ /all|xs/) {
+  if (! $Method::Generate::Accessor::CAN_HAZ_XS)
   {
-    local $Method::Generate::Accessor::CAN_HAZ_XS = 1;
-    _add_moosey_has (moo_XS => 'Moo');
+    die "Requested XS benchmarks but XS isn't available in Method::Generate::Accessor";
   }
+
+  _add_moosey_has (moo_XS => 'Moo');
   _add_moosey_has (mouse_XS => 'Mouse')
-    unless $ENV{MOUSE_PUREPERL};
 }
 
 
@@ -75,32 +74,30 @@ for (1, 2) {
 
   my $objects;
 
-  print "\n\nBenching new()\n====================\n";
-
-  cmpthese ( -1, { map {
-    my $type = $_;
-    "${type}->new" => sub {
-      $objects->{$type} = $class_types->{$type}->new
-        for (1 .. $opts->{iterations});
+  for my $use_attrs (0, 1) {
+    for my $attr (keys %$attrs_to_bench) {
+      printf "\n\nBenching %s ( %s )\n====================\n",
+        $attr,
+        $use_attrs
+          ? ($opts->{reuse} ? '' : 'new() and ' ) . 'get/set/get cycle'
+          : 'new() only'
+        ,
+      ;
+
+      cmpthese ( -1, { map {
+        my $type = $_;
+        "${type}->$attr" => sub {
+          $objects->{$type} = $class_types->{$type}->new
+            unless ( $use_attrs && $opts->{reuse} );
+
+          for (1 .. $opts->{iterations} ) {
+            my $init = $objects->{$type}->$attr;
+            $objects->{$type}->$attr('foo') unless $attr eq 'ro';
+            my $set = $objects->{$type}->$attr;
+          }
+        };
+      } keys %$class_types } );
     }
-  } keys %$class_types } );
-
-  for my $attr (keys %$attrs_to_bench) {
-    print "\n\nBenching $attr\n====================\n";
-
-    cmpthese ( -1, { map {
-      my $type = $_;
-      "${type}->$attr" => sub {
-        $objects->{$type} = $class_types->{$type}->new
-          unless $opts->{reuse};
-
-        for (1 .. $opts->{iterations} ) {
-          my $init = $objects->{$type}->$attr;
-          $objects->{$type}->$attr('foo');
-          my $set = $objects->{$type}->$attr;
-        }
-      }
-    } keys %$objects } );
   }
 }