benchmarks/subtype.pl

   1 #!perl
   2 use strict;
   3 use warnings;
   4 use Benchmark qw/cmpthese/;
   5
   6 for my $klass (qw/Moose Mouse/) {
   7     eval qq{
   8         package ${klass}One;
   9         use $klass;
  10         use ${klass}::Util::TypeConstraints;
  11
  12         subtype 'NaturalNumber', as 'Int', where { \$_ > 0 };
  13
  14         has n => (
  15             is  => 'rw',
  16             isa => 'NaturalNumber',
  17         );
  18         no $klass;
  19         __PACKAGE__->meta->make_immutable;
  20     };
  21     die $@ if $@;
  22 }
  23
  24 #use Data::Dumper;
  25 #$Data::Dumper::Deparse = 1;
  26 #$Data::Dumper::Indent  = 1;
  27 #print Mouse::Util::TypeConstraints::find_type_constraint('NaturalNumber')->dump(3);
  28 #print Moose::Util::TypeConstraints::find_type_constraint('NaturalNumber')->dump(3);
  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 => 3) } }
  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 => 3)->n(5) } }
  46         map { "${_}One" }
  47         qw/Moose Mouse/
  48     }
  49 );
  50
  51 print "---- set\n";
  52 my %c = map { $_ => "${_}One"->new(n => 3) } qw/Moose Mouse/;
  53 cmpthese(
  54     -1 => {
  55         map { my $y = $_; $_ => sub { $c{$y}->n(5) } }
  56         qw/Moose Mouse/
  57     }
  58 );