Moose-2.1405HEADMoose-2.1405master

3 files changed, 140 insertions, 0 deletions

diff --git a/benchmarks/cmop/lib/Bench/Accessor.pm b/benchmarks/cmop/lib/Bench/Accessor.pm
new file mode 100644
index 0000000..3f30239
--- /dev/null
+++ b/benchmarks/cmop/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/benchmarks/cmop/lib/Bench/Construct.pm b/benchmarks/cmop/lib/Bench/Construct.pm
new file mode 100644
index 0000000..c290304
--- /dev/null
+++ b/benchmarks/cmop/lib/Bench/Construct.pm
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+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 {
+    my $self = shift;
+
+    my $class = $self->class;
+    my @args  = $self->args;
+
+    sub { my $obj = $class->new( @args ) }
+}
+
+__PACKAGE__;
+
+__END__
diff --git a/benchmarks/cmop/lib/Bench/Run.pm b/benchmarks/cmop/lib/Bench/Run.pm
new file mode 100644
index 0000000..09ac1b6
--- /dev/null
+++ b/benchmarks/cmop/lib/Bench/Run.pm
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+package Bench::Run;
+use Moose;
+
+use Benchmark qw/:hireswallclock :all/;
+
+has classes => (
+    isa => "ArrayRef",
+    is  => "rw",
+    auto_deref => 1,
+);
+
+has benchmarks => (
+    isa => "ArrayRef",
+    is  => "rw",
+    auto_deref => 1,
+);
+
+has min_time => (
+    isa => "Num",
+    is  => "rw",
+    default => 5,
+);
+
+sub run {
+    my $self = shift;
+
+    foreach my $bench ( $self->benchmarks ) {
+        my $bench_class = delete $bench->{class};
+        my $name        = delete $bench->{name} || $bench_class;
+        my @bench_args  = %$bench;
+
+        eval "require $bench_class";
+        die $@ if $@;
+
+        my %res;
+
+        foreach my $class ( $self->classes ) {
+            eval "require $class";
+            die $@ if $@;
+
+            my $b = $bench_class->new( @bench_args, class => $class );
+            $res{$class} = countit( $self->min_time, $b->code );
+        }
+
+        print "- $name:\n";
+        cmpthese( \%res );
+        print "\n";
+    }
+}
+
+__PACKAGE__;
+
+__END__