From: gfx <gfuji@cpan.org>
Date: Sat, 31 Oct 2009 08:22:36 +0000 (+0900)
Subject: Split benchmarks/accessors.pl to two files
X-Git-Tag: 0.40_04~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c6821d12fa22d1236df47b12749f1517493c2cf4;p=gitmo%2FMouse.git

Split benchmarks/accessors.pl to two files
---

diff --git a/benchmarks/accessors.pl b/benchmarks/accessors.pl
index 68ceffe..67a1cb2 100644
--- a/benchmarks/accessors.pl
+++ b/benchmarks/accessors.pl
@@ -32,16 +32,6 @@ my $cxsa_is_loaded = eval q{
         lazy    => 1,
         default => 42,
     );
-    has with_tc => (
-        is  => 'rw',
-        isa => 'Int',
-    );
-
-    has with_tc_class_type => (
-        is  => 'rw',
-        isa => 'Foo',
-    );
-
     __PACKAGE__->meta->make_immutable;
 }
 {
@@ -55,15 +45,6 @@ my $cxsa_is_loaded = eval q{
         lazy    => 1,
         default => 42,
     );
-    has with_tc => (
-        is  => 'rw',
-        isa => 'Int',
-    );
-    has with_tc_class_type => (
-        is  => 'rw',
-        isa => 'Foo',
-    );
-
     __PACKAGE__->meta->make_immutable;
 }
 
@@ -139,40 +120,3 @@ cmpthese -1 => {
     },
     ) : (),
 };
-
-print "\nSETTING for attributes with type constraints 'Int' (except for C::XSAccessor)\n";
-cmpthese -1 => {
-    'Mouse' => sub{
-        $mi->with_tc(10);
-        $mi->with_tc(10);
-    },
-    'Moose' => sub{
-        $mx->with_tc(10);
-        $mx->with_tc(10);
-    },
-    $cxsa_is_loaded ? (
-    'C::XSAccessor' => sub{
-        $cx->simple(10);
-        $cx->simple(10);
-    },
-    ) : (),
-};
-
-print "\nSETTING for attributes with type constraints 'Foo' (except for C::XSAccessor)\n";
-my $foo = Foo->new;
-cmpthese -1 => {
-    'Mouse' => sub{
-        $mi->with_tc_class_type($foo);
-        $mi->with_tc_class_type($foo);
-    },
-    'Moose' => sub{
-        $mx->with_tc_class_type($foo);
-        $mx->with_tc_class_type($foo);
-    },
-    $cxsa_is_loaded ? (
-    'C::XSAccessor' => sub{
-        $cx->simple($foo);
-        $cx->simple($foo);
-    },
-    ) : (),
-};
diff --git a/benchmarks/type_constraints.pl b/benchmarks/type_constraints.pl
new file mode 100644
index 0000000..160e102
--- /dev/null
+++ b/benchmarks/type_constraints.pl
@@ -0,0 +1,163 @@
+#!perl
+use strict;
+use Benchmark qw(:all);
+use Config; printf "Perl/%vd in $Config{archname}\n\n", $^V;
+use warnings;
+no warnings 'once';
+
+my $cxsa_is_loaded = eval q{
+    package CXSA;
+    use Class::XSAccessor
+        constructor => 'new',
+        accessors   => {
+            simple => 'simple',
+        },
+    ;
+    1;
+};
+
+{
+    package Foo;
+    sub new { bless {}, shift }
+}
+
+{
+    package MouseOne;
+    use Mouse;
+    has simple => (
+        is => 'rw',
+    );
+    has with_lazy => (
+        is      => 'rw',
+        lazy    => 1,
+        default => 42,
+    );
+    has with_tc => (
+        is  => 'rw',
+        isa => 'Int',
+    );
+
+    has with_tc_class_type => (
+        is  => 'rw',
+        isa => 'Foo',
+    );
+
+    has with_tc_array_of_int => (
+        is  => 'rw',
+        isa => 'ArrayRef[Int]',
+    );
+    __PACKAGE__->meta->make_immutable;
+}
+{
+    package MooseOne;
+    use Moose;
+    has simple => (
+        is => 'rw',
+    );
+    has with_lazy => (
+        is      => 'rw',
+        lazy    => 1,
+        default => 42,
+    );
+    has with_tc => (
+        is  => 'rw',
+        isa => 'Int',
+    );
+    has with_tc_class_type => (
+        is  => 'rw',
+        isa => 'Foo',
+    );
+    has with_tc_array_of_int => (
+        is  => 'rw',
+        isa => 'ArrayRef[Int]',
+    );
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+use B qw(svref_2object);
+
+print "Moose/$Moose::VERSION (Class::MOP/$Class::MOP::VERSION)\n";
+print "Mouse/$Mouse::VERSION\n";
+print "Class::XSAccessor/$Class::XSAccessor::VERSION\n" if $cxsa_is_loaded;
+
+my $mi = MouseOne->new();
+my $mx = MooseOne->new();
+my $cx;
+$cx = CXSA->new       if $cxsa_is_loaded;
+
+print "\nSETTING for simple attributes\n";
+cmpthese -1 => {
+    'Mouse' => sub{
+        $mi->simple(10);
+        $mi->simple(10);
+    },
+    'Moose' => sub{
+        $mx->simple(10);
+        $mx->simple(10);
+    },
+    $cxsa_is_loaded ? (
+    'C::XSAccessor' => sub{
+        $cx->simple(10);
+        $cx->simple(10);
+    },
+    ) : (),
+
+};
+
+print "\nSETTING for attributes with type constraints 'Int' (except for C::XSAccessor)\n";
+cmpthese -1 => {
+    'Mouse' => sub{
+        $mi->with_tc(10);
+        $mi->with_tc(10);
+    },
+    'Moose' => sub{
+        $mx->with_tc(10);
+        $mx->with_tc(10);
+    },
+    $cxsa_is_loaded ? (
+    'C::XSAccessor' => sub{
+        $cx->simple(10);
+        $cx->simple(10);
+    },
+    ) : (),
+};
+
+print "\nSETTING for attributes with type constraints 'Foo' (except for C::XSAccessor)\n";
+my $foo = Foo->new;
+cmpthese -1 => {
+    'Mouse' => sub{
+        $mi->with_tc_class_type($foo);
+        $mi->with_tc_class_type($foo);
+    },
+    'Moose' => sub{
+        $mx->with_tc_class_type($foo);
+        $mx->with_tc_class_type($foo);
+    },
+    $cxsa_is_loaded ? (
+    'C::XSAccessor' => sub{
+        $cx->simple($foo);
+        $cx->simple($foo);
+    },
+    ) : (),
+};
+
+print "\nSETTING for attributes with type constraints 'ArrayRef[Int]' (except for C::XSAccessor)\n";
+
+$foo = [10, 20];
+cmpthese -1 => {
+    'Mouse' => sub{
+        $mi->with_tc_array_of_int($foo);
+        $mi->with_tc_array_of_int($foo);
+    },
+    'Moose' => sub{
+        $mx->with_tc_array_of_int($foo);
+        $mx->with_tc_array_of_int($foo);
+    },
+    $cxsa_is_loaded ? (
+    'C::XSAccessor' => sub{
+        $cx->simple($foo);
+        $cx->simple($foo);
+    },
+    ) : (),
+};