Changelogging
[gitmo/Mouse.git] / benchmarks / coercion.pl
1 #!perl
2 use strict;
3 use warnings;
4 use Benchmark qw/cmpthese/;
5
6
7 for my $klass (qw/Moose Mouse/) {
8     eval qq{
9         package ${klass}One;
10         use $klass;\r
11         use ${klass}::Util::TypeConstraints;
12 \r
13         subtype 'NaturalNumber', as 'Int', where { \$_ > 0 };
14
15         coerce 'NaturalNumber',
16             from 'Str', via { 42 },
17         ;\r
18 \r
19         has n => (
20             is     => 'rw',
21             isa    => 'NaturalNumber',
22             coerce => 1,
23         );
24         no $klass;
25         __PACKAGE__->meta->make_immutable;
26     };
27     die $@ if $@;
28 }
29
30 print "Class::MOP: $Class::MOP::VERSION\n";
31 print "Moose:      $Moose::VERSION\n";
32 print "Mouse:      $Mouse::VERSION\n";
33 print "---- new\n";
34 cmpthese(
35     -1 => {
36         map { my $x = $_; $_ => sub { $x->new(n => 'foo') } }
37         map { "${_}One" }
38         qw/Moose Mouse/
39     }
40 );
41
42 print "---- new,set\n";
43 cmpthese(
44     -1 => {
45         map { my $y = $_; $_ => sub { $y->new(n => 'foo')->n('bar') } }
46         map { "${_}One" }
47         qw/Moose Mouse/
48     }
49 );
50
51 print "---- set\n";
52 my %c = map { $_ => "${_}One"->new(n => 'foo') } qw/Moose Mouse/;
53 cmpthese(
54     -1 => {
55         map { my $y = $_; $_ => sub { $c{$y}->n('bar') } }
56         qw/Moose Mouse/
57     }
58 );