Make compatibility tests optional. Its is almost useless now.
[gitmo/Mouse.git] / 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     __PACKAGE__->meta->make_immutable;
36 }
37 {
38     package MooseOne;
39     use Moose;
40     has simple => (
41         is => 'rw',
42     );
43     has with_lazy => (
44         is      => 'rw',
45         lazy    => 1,
46         default => 42,
47     );
48     __PACKAGE__->meta->make_immutable;
49 }
50
51 use B qw(svref_2object);
52
53 print "Moose/$Moose::VERSION (Class::MOP/$Class::MOP::VERSION)\n";
54 print "Mouse/$Mouse::VERSION\n";
55 print "Class::XSAccessor/$Class::XSAccessor::VERSION\n" if $cxsa_is_loaded;
56
57 my $mi = MouseOne->new();
58 my $mx = MooseOne->new();
59 my $cx;
60 $cx = CXSA->new       if $cxsa_is_loaded;
61
62
63 print "\nGETTING for simple attributes\n";
64 cmpthese -1 => {
65     'Mouse' => sub{
66         my $x;
67         $x = $mi->simple();
68         $x = $mi->simple();
69     },
70     'Moose' => sub{
71         my $x;
72         $x = $mx->simple();
73         $x = $mx->simple();
74     },
75     $cxsa_is_loaded ? (
76     'C::XSAccessor' => sub{
77         my $x;
78         $x = $cx->simple();
79         $x = $cx->simple();
80     },
81     ) : (),
82 };
83
84 print "\nSETTING for simple attributes\n";
85 cmpthese -1 => {
86     'Mouse' => sub{
87         $mi->simple(10);
88         $mi->simple(10);
89     },
90     'Moose' => sub{
91         $mx->simple(10);
92         $mx->simple(10);
93     },
94     $cxsa_is_loaded ? (
95     'C::XSAccessor' => sub{
96         $cx->simple(10);
97         $cx->simple(10);
98     },
99     ) : (),
100
101 };
102
103 print "\nGETTING for lazy attributes (except for C::XSAccessor)\n";
104 cmpthese -1 => {
105     'Mouse' => sub{
106         my $x;
107         $x = $mi->with_lazy();
108         $x = $mi->with_lazy();
109     },
110     'Moose' => sub{
111         my $x;
112         $x = $mx->with_lazy();
113         $x = $mx->with_lazy();
114     },
115     $cxsa_is_loaded ? (
116     'C::XSAccessor' => sub{
117         my $x;
118         $x = $cx->simple();
119         $x = $cx->simple();
120     },
121     ) : (),
122 };