benchmarks/immutable.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Scalar::Util 'blessed';
   7 use Benchmark qw[cmpthese];
   8
   9 use Moose::Util::TypeConstraints;
  10
  11 {
  12     package Foo;
  13     use Moose;
  14     Foo->meta->make_immutable(debug => 0);
  15 }
  16
  17 coerce 'Foo'
  18     => from 'ArrayRef'
  19     => via { Foo->new(@{$_}) };
  20
  21 {
  22     package Foo::Normal;
  23     use Moose;
  24
  25     has 'default'         => (is => 'rw', default => 10);
  26     has 'default_sub'     => (is => 'rw', default => sub { [] });
  27     has 'lazy'            => (is => 'rw', default => 10, lazy => 1);
  28     has 'required'        => (is => 'rw', required => 1);
  29     has 'weak_ref'        => (is => 'rw', weak_ref => 1);
  30     has 'type_constraint' => (is => 'rw', isa => 'Foo');
  31     has 'coercion'        => (is => 'rw', isa => 'Foo', coerce => 1);
  32
  33 }
  34
  35 {
  36     package Foo::Immutable;
  37     use Moose;
  38
  39     has 'default'         => (is => 'rw', default => 10);
  40     has 'default_sub'     => (is => 'rw', default => sub { [] });
  41     has 'lazy'            => (is => 'rw', default => 10, lazy => 1);
  42     has 'required'        => (is => 'rw', required => 1);
  43     has 'weak_ref'        => (is => 'rw', weak_ref => 1);
  44     has 'type_constraint' => (is => 'rw', isa => 'Foo');
  45     has 'coercion'        => (is => 'rw', isa => 'Foo', coerce => 1);
  46
  47     sub BUILD {
  48         # ...
  49     }
  50
  51     Foo::Immutable->meta->make_immutable(debug => 1);
  52 }
  53
  54 #__END__
  55
  56 my $foo = Foo->new;
  57
  58 cmpthese(500,
  59     {
  60         'normal' => sub {
  61             Foo::Normal->new(
  62                 required        => 'BAR',
  63                 type_constraint => $foo,
  64                 coercion        => [],
  65                 weak_ref        => {},
  66             );
  67         },
  68         'immutable' => sub {
  69             Foo::Immutable->new(
  70                 required        => 'BAR',
  71                 type_constraint => $foo,
  72                 coercion        => [],
  73                 weak_ref        => {},
  74             );
  75         },
  76     }
  77 );