benchmarks/type_constraints2.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Benchmark qw[timethese];
   7
   8 =pod
   9
  10 This benchmark is designed to measure how long things with type constraints
  11 take (constructors, accessors). It was created to measure the impact of
  12 inlining type constraints.
  13
  14 =cut
  15
  16 {
  17     package Thing;
  18
  19     use Moose;
  20
  21     has int => (
  22         is  => 'rw',
  23         isa => 'Int',
  24     );
  25
  26     has str => (
  27         is  => 'rw',
  28         isa => 'Str',
  29     );
  30
  31     has fh => (
  32         is  => 'rw',
  33         isa => 'FileHandle',
  34     );
  35
  36     has object => (
  37         is  => 'rw',
  38         isa => 'Object',
  39     );
  40
  41     has a_int => (
  42         is  => 'rw',
  43         isa => 'ArrayRef[Int]',
  44     );
  45
  46     has a_str => (
  47         is  => 'rw',
  48         isa => 'ArrayRef[Str]',
  49     );
  50
  51     has a_fh => (
  52         is  => 'rw',
  53         isa => 'ArrayRef[FileHandle]',
  54     );
  55
  56     has a_object => (
  57         is  => 'rw',
  58         isa => 'ArrayRef[Object]',
  59     );
  60
  61     has h_int => (
  62         is  => 'rw',
  63         isa => 'HashRef[Int]',
  64     );
  65
  66     has h_str => (
  67         is  => 'rw',
  68         isa => 'HashRef[Str]',
  69     );
  70
  71     has h_fh => (
  72         is  => 'rw',
  73         isa => 'HashRef[FileHandle]',
  74     );
  75
  76     has h_object => (
  77         is  => 'rw',
  78         isa => 'HashRef[Object]',
  79     );
  80
  81     __PACKAGE__->meta->make_immutable;
  82 }
  83
  84 {
  85     package Simple;
  86     use Moose;
  87
  88     has str => (
  89         is  => 'rw',
  90         isa => 'Str',
  91     );
  92
  93     __PACKAGE__->meta->make_immutable;
  94 }
  95
  96 my @ints    = 1 .. 10;
  97 my @strs    = 'a' .. 'j';
  98 my @fhs     = map { my $fh; open $fh, '<', $0 or die; $fh; } 1 .. 10;
  99 my @objects = map { Thing->new } 1 .. 10;
 100
 101 my %ints    = map { $_ => $_ } @ints;
 102 my %strs    = map { $_ => $_ } @ints;
 103 my %fhs     = map { $_ => $_ } @fhs;
 104 my %objects = map { $_ => $_ } @objects;
 105
 106 my $thing = Thing->new;
 107 my $simple = Simple->new;
 108
 109 timethese(
 110     1_000_000, {
 111         constructor_simple => sub {
 112             Simple->new( str => $strs[0] );
 113         },
 114         accessors_simple => sub {
 115             $simple->str( $strs[0] );
 116         },
 117     }
 118 );
 119
 120 timethese(
 121     20_000, {
 122         constructor_all => sub {
 123             Thing->new(
 124                 int      => $ints[0],
 125                 str      => $strs[0],
 126                 fh       => $fhs[0],
 127                 object   => $objects[0],
 128                 a_int    => \@ints,
 129                 a_str    => \@strs,
 130                 a_fh     => \@fhs,
 131                 a_object => \@objects,
 132                 h_int    => \%ints,
 133                 h_str    => \%strs,
 134                 h_fh     => \%fhs,
 135                 h_object => \%objects,
 136             );
 137         },
 138         accessors_all => sub {
 139             $thing->int( $ints[0] );
 140             $thing->str( $strs[0] );
 141             $thing->fh( $fhs[0] );
 142             $thing->object( $objects[0] );
 143             $thing->a_int( \@ints );
 144             $thing->a_str( \@strs );
 145             $thing->a_fh( \@fhs );
 146             $thing->a_object( \@objects );
 147             $thing->h_int( \%ints );
 148             $thing->h_str( \%strs );
 149             $thing->h_fh( \%fhs );
 150             $thing->h_object( \%objects );
 151         },
 152     }
 153 );
 154