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;
  11         use ${klass}::Util::TypeConstraints;
  12
  13         subtype 'NaturalNumber', as 'Int', where { \$_ > 0 };
  14
  15         coerce 'NaturalNumber',
  16             from 'Str', via { 42 },
  17         ;
  18
  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 );