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 my @ints    = 1 .. 10;
  85 my @strs    = 'a' .. 'j';
  86 my @fhs     = map { my $fh; open $fh, '<', $0 or die; $fh; } 1 .. 10;
  87 my @objects = map { Thing->new } 1 .. 10;
  88
  89 my %ints    = map { $_ => $_ } @ints;
  90 my %strs    = map { $_ => $_ } @ints;
  91 my %fhs     = map { $_ => $_ } @fhs;
  92 my %objects = map { $_ => $_ } @objects;
  93
  94 timethese(
  95     200_00, {
  96         constructor => sub {
  97             Thing->new(
  98                 int      => $ints[0],
  99                 str      => $strs[0],
 100                 fh       => $fhs[0],
 101                 object   => $objects[0],
 102                 a_int    => \@ints,
 103                 a_str    => \@strs,
 104                 a_fh     => \@fhs,
 105                 a_object => \@objects,
 106                 h_int    => \%ints,
 107                 h_str    => \%strs,
 108                 h_fh     => \%fhs,
 109                 h_object => \%objects,
 110             );
 111         },
 112         accessors => sub {
 113             my $thing = Thing->new;
 114
 115             $thing->int( $ints[0] );
 116             $thing->str( $strs[0] );
 117             $thing->fh( $fhs[0] );
 118             $thing->object( $objects[0] );
 119             $thing->a_int( \@ints );
 120             $thing->a_str( \@strs );
 121             $thing->a_fh( \@fhs );
 122             $thing->a_object( \@objects );
 123             $thing->h_int( \%ints );
 124             $thing->h_str( \%strs );
 125             $thing->h_fh( \%fhs );
 126             $thing->h_object( \%objects );
 127         },
 128     }
 129 );
 130