benchmarks/accessors.pl

   1 #!perl
   2 use strict;
   3 use Benchmark qw(:all);
   4 use Config; printf "Perl/%vd in $Config{archname}\n\n", $^V;
   5 use warnings;
   6 no warnings 'once';
   7
   8 my $cxsa_is_loaded = eval q{
   9     package CXSA;
  10     use Class::XSAccessor
  11         constructor => 'new',
  12         accessors   => {
  13             simple => 'simple',
  14         },
  15     ;
  16     1;
  17 };
  18
  19 {
  20     package Foo;
  21     sub new { bless {}, shift }
  22 }
  23
  24 {
  25     package MouseOne;
  26     use Mouse;
  27     has simple => (
  28         is => 'rw',
  29     );
  30     has with_lazy => (
  31         is      => 'rw',
  32         lazy    => 1,
  33         default => 42,
  34     );
  35     has with_tc => (
  36         is  => 'rw',
  37         isa => 'Int',
  38     );
  39
  40     has with_tc_class_type => (
  41         is  => 'rw',
  42         isa => 'Foo',
  43     );
  44
  45     __PACKAGE__->meta->make_immutable;
  46 }
  47 {
  48     package MooseOne;
  49     use Moose;
  50     has simple => (
  51         is => 'rw',
  52     );
  53     has with_lazy => (
  54         is      => 'rw',
  55         lazy    => 1,
  56         default => 42,
  57     );
  58     has with_tc => (
  59         is  => 'rw',
  60         isa => 'Int',
  61     );
  62     has with_tc_class_type => (
  63         is  => 'rw',
  64         isa => 'Foo',
  65     );
  66
  67     __PACKAGE__->meta->make_immutable;
  68 }
  69
  70 use B qw(svref_2object);
  71
  72 print "Moose/$Moose::VERSION (Class::MOP/$Class::MOP::VERSION)\n";
  73 print "Mouse/$Mouse::VERSION\n";
  74 print "Class::XSAccessor/$Class::XSAccessor::VERSION\n" if $cxsa_is_loaded;
  75
  76 my $mi = MouseOne->new();
  77 my $mx = MooseOne->new();
  78 my $cx;
  79 $cx = CXSA->new       if $cxsa_is_loaded;
  80
  81
  82 print "\nGETTING for simple attributes\n";
  83 cmpthese -1 => {
  84     'Mouse' => sub{
  85         my $x;
  86         $x = $mi->simple();
  87         $x = $mi->simple();
  88     },
  89     'Moose' => sub{
  90         my $x;
  91         $x = $mx->simple();
  92         $x = $mx->simple();
  93     },
  94     $cxsa_is_loaded ? (
  95     'C::XSAccessor' => sub{
  96         my $x;
  97         $x = $cx->simple();
  98         $x = $cx->simple();
  99     },
 100     ) : (),
 101 };
 102
 103 print "\nSETTING for simple attributes\n";
 104 cmpthese -1 => {
 105     'Mouse' => sub{
 106         $mi->simple(10);
 107         $mi->simple(10);
 108     },
 109     'Moose' => sub{
 110         $mx->simple(10);
 111         $mx->simple(10);
 112     },
 113     $cxsa_is_loaded ? (
 114     'C::XSAccessor' => sub{
 115         $cx->simple(10);
 116         $cx->simple(10);
 117     },
 118     ) : (),
 119
 120 };
 121
 122 print "\nGETTING for lazy attributes (except for C::XSAccessor)\n";
 123 cmpthese -1 => {
 124     'Mouse' => sub{
 125         my $x;
 126         $x = $mi->with_lazy();
 127         $x = $mi->with_lazy();
 128     },
 129     'Moose' => sub{
 130         my $x;
 131         $x = $mx->with_lazy();
 132         $x = $mx->with_lazy();
 133     },
 134     $cxsa_is_loaded ? (
 135     'C::XSAccessor' => sub{
 136         my $x;
 137         $x = $cx->simple();
 138         $x = $cx->simple();
 139     },
 140     ) : (),
 141 };
 142
 143 print "\nSETTING for attributes with type constraints 'Int' (except for C::XSAccessor)\n";
 144 cmpthese -1 => {
 145     'Mouse' => sub{
 146         $mi->with_tc(10);
 147         $mi->with_tc(10);
 148     },
 149     'Moose' => sub{
 150         $mx->with_tc(10);
 151         $mx->with_tc(10);
 152     },
 153     $cxsa_is_loaded ? (
 154     'C::XSAccessor' => sub{
 155         $cx->simple(10);
 156         $cx->simple(10);
 157     },
 158     ) : (),
 159 };
 160
 161 print "\nSETTING for attributes with type constraints 'Foo' (except for C::XSAccessor)\n";
 162 my $foo = Foo->new;
 163 cmpthese -1 => {
 164     'Mouse' => sub{
 165         $mi->with_tc_class_type($foo);
 166         $mi->with_tc_class_type($foo);
 167     },
 168     'Moose' => sub{
 169         $mx->with_tc_class_type($foo);
 170         $mx->with_tc_class_type($foo);
 171     },
 172     $cxsa_is_loaded ? (
 173     'C::XSAccessor' => sub{
 174         $cx->simple($foo);
 175         $cx->simple($foo);
 176     },
 177     ) : (),
 178 };