Add accessor benchmarks

diff --git a/bench/all.yml b/bench/all.yml
index 093a833..0a71cfa 100644 (file)
--- a/bench/all.yml
+++ b/bench/all.yml
@@ -1,11 +1,25 @@
 ---
-- name: Construction of Point classes
+- name: Point classes
   classes:
   - 'MOP::Point'
   - 'Plain::Point'
   benchmarks:
     - class: 'Bench::Construct'
+      name: object construction
       args:
         x: 7
         y: 137
+    - class: 'Bench::Accessor'
+      name: accessor get
+      construct:
+        x: 4
+        y: 6
+      accessor: x
+    - class: 'Bench::Accessor'
+      name: accessor set
+      construct:
+        x: 4
+        y: 6
+      accessor: x
+      accessor_args: [ 5 ]
 

diff --git a/bench/lib/Bench/Accessor.pm b/bench/lib/Bench/Accessor.pm
new file mode 100644 (file)
index 0000000..3f30239
--- /dev/null
+++ b/bench/lib/Bench/Accessor.pm
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+package Bench::Accessor;
+use Moose;
+use Moose::Util::TypeConstraints;
+
+eval {
+coerce ArrayRef
+    => from HashRef
+        => via { [ %$_ ] };
+};
+
+has class => (
+    isa => "Str",
+    is  => "ro",
+);
+
+has construct => (
+    isa => "ArrayRef",
+    is  => "ro",
+    auto_deref => 1,
+    coerce     => 1,
+);
+
+has accessor => (
+    isa => "Str",
+    is  => "ro",
+);
+
+has accessor_args => (
+    isa => "ArrayRef",
+    is  => "ro",
+    auto_deref => 1,
+    coerce     => 1,
+);
+
+sub code {
+    my $self = shift;
+
+    my $obj = $self->class->new( $self->construct );
+    my @accessor_args = $self->accessor_args;
+    my $accessor = $self->accessor;
+
+    sub { $obj->$accessor( @accessor_args ) };
+}
+
+__PACKAGE__;
+
+__END__

diff --git a/bench/lib/Bench/Construct.pm b/bench/lib/Bench/Construct.pm
index 6eb90f9..c290304 100644 (file)
--- a/bench/lib/Bench/Construct.pm
+++ b/bench/lib/Bench/Construct.pm
@@ -2,16 +2,24 @@
 
 package Bench::Construct;
 use Moose;
+use Moose::Util::TypeConstraints;
 
 has class => (
     isa => "Str",
     is  => "ro",
 );
 
+eval {
+coerce ArrayRef
+    => from HashRef
+        => via { [ %$_ ] };
+};
+
 has args => (
     isa => "ArrayRef",
     is  => "ro",
     auto_deref => 1,
+    coerce     => 1,
 );
 
 sub code {

diff --git a/bench/lib/Bench/Run.pm b/bench/lib/Bench/Run.pm
index fc2009f..09ac1b6 100644 (file)
--- a/bench/lib/Bench/Run.pm
+++ b/bench/lib/Bench/Run.pm
@@ -27,8 +27,9 @@ sub run {
     my $self = shift;
 
     foreach my $bench ( $self->benchmarks ) {
-        my $bench_class = $bench->{class};
-        my @bench_args  = ( (ref($bench->{args}) eq "ARRAY") ? @{ $bench->{args} } : %{ $bench->{args} } );
+        my $bench_class = delete $bench->{class};
+        my $name        = delete $bench->{name} || $bench_class;
+        my @bench_args  = %$bench;
 
         eval "require $bench_class";
         die $@ if $@;
@@ -43,7 +44,7 @@ sub run {
             $res{$class} = countit( $self->min_time, $b->code );
         }
 
-        print "$bench_class:\n";
+        print "- $name:\n";
         cmpthese( \%res );
         print "\n";
     }

diff --git a/bench/run_yml.pl b/bench/run_yml.pl
index 409de84..9ec14d6 100644 (file)
--- a/bench/run_yml.pl
+++ b/bench/run_yml.pl
@@ -12,8 +12,9 @@ use Bench::Run;
 my $data = LoadFile( shift || "$FindBin::Bin/all.yml" );
 
 foreach my $bench ( @$data ) {
-    print delete $bench->{name}, "\n";
+    print "== ", delete $bench->{name}, " ==\n\n";
     Bench::Run->new( %$bench )->run;
+    print "\n\n";
 }