From: gfx <gfuji@cpan.org>
Date: Wed, 30 Sep 2009 12:47:15 +0000 (+0900)
Subject: Add benchmarks about subtype and coercion
X-Git-Tag: 0.37_01~13
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d03295d720223421e5878677fd4cb66b62f92a67;p=gitmo%2FMouse.git

Add benchmarks about subtype and coercion
---

diff --git a/benchmarks/coercion.pl b/benchmarks/coercion.pl
new file mode 100755
index 0000000..a473303
--- /dev/null
+++ b/benchmarks/coercion.pl
@@ -0,0 +1,58 @@
+#!perl
+use strict;
+use warnings;
+use Benchmark qw/cmpthese/;
+
+
+for my $klass (qw/Moose Mouse/) {
+    eval qq{
+        package ${klass}One;
+        use $klass;
+        use ${klass}::Util::TypeConstraints;
+
+        subtype 'NaturalNumber', as 'Int', where { \$_ > 0 };
+
+        coerce 'NaturalNumber',
+            from 'Str', via { 42 },
+        ;
+
+        has n => (
+            is     => 'rw',
+            isa    => 'NaturalNumber',
+            coerce => 1,
+        );
+        no $klass;
+        __PACKAGE__->meta->make_immutable;
+    };
+    die $@ if $@;
+}
+
+print "Class::MOP: $Class::MOP::VERSION\n";
+print "Moose:      $Moose::VERSION\n";
+print "Mouse:      $Mouse::VERSION\n";
+print "---- new\n";
+cmpthese(
+    -1 => {
+        map { my $x = $_; $_ => sub { $x->new(n => 'foo') } }
+        map { "${_}One" }
+        qw/Moose Mouse/
+    }
+);
+
+print "---- new,set\n";
+cmpthese(
+    -1 => {
+        map { my $y = $_; $_ => sub { $y->new(n => 'foo')->n('bar') } }
+        map { "${_}One" }
+        qw/Moose Mouse/
+    }
+);
+
+print "---- set\n";
+my %c = map { $_ => "${_}One"->new(n => 'foo') } qw/Moose Mouse/;
+cmpthese(
+    -1 => {
+        map { my $y = $_; $_ => sub { $c{$y}->n('bar') } }
+        qw/Moose Mouse/
+    }
+);
diff --git a/benchmarks/subtype.pl b/benchmarks/subtype.pl
new file mode 100755
index 0000000..5c53508
--- /dev/null
+++ b/benchmarks/subtype.pl
@@ -0,0 +1,58 @@
+#!perl
+use strict;
+use warnings;
+use Benchmark qw/cmpthese/;
+
+for my $klass (qw/Moose Mouse/) {
+    eval qq{
+        package ${klass}One;
+        use $klass;
+        use ${klass}::Util::TypeConstraints;
+
+        subtype 'NaturalNumber', as 'Int', where { \$_ > 0 };
+
+        has n => (
+            is  => 'rw',
+            isa => 'NaturalNumber',
+        );
+        no $klass;
+        __PACKAGE__->meta->make_immutable;
+    };
+    die $@ if $@;
+}
+
+use Data::Dumper;
+$Data::Dumper::Deparse = 1;
+$Data::Dumper::Indent  = 1;
+print Mouse::Util::TypeConstraints::find_type_constraint('NaturalNumber')->dump(3);
+print Moose::Util::TypeConstraints::find_type_constraint('NaturalNumber')->dump(3);
+
+print "Class::MOP: $Class::MOP::VERSION\n";
+print "Moose:      $Moose::VERSION\n";
+print "Mouse:      $Mouse::VERSION\n";
+print "---- new\n";
+cmpthese(
+    -1 => {
+        map { my $x = $_; $_ => sub { $x->new(n => 3) } }
+        map { "${_}One" }
+        qw/Moose Mouse/
+    }
+);
+
+print "---- new,set\n";
+cmpthese(
+    -1 => {
+        map { my $y = $_; $_ => sub { $y->new(n => 3)->n(5) } }
+        map { "${_}One" }
+        qw/Moose Mouse/
+    }
+);
+
+print "---- set\n";
+my %c = map { $_ => "${_}One"->new(n => 3) } qw/Moose Mouse/;
+cmpthese(
+    -1 => {
+        map { my $y = $_; $_ => sub { $c{$y}->n(5) } }
+        qw/Moose Mouse/
+    }
+);