Commit | Line | Data |
c6821d12 |
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; |
32aaae09 |
27 | use Mouse::Util::TypeConstraints; |
c6821d12 |
28 | has simple => ( |
29 | is => 'rw', |
30 | ); |
31 | has with_lazy => ( |
32 | is => 'rw', |
33 | lazy => 1, |
34 | default => 42, |
35 | ); |
36 | has with_tc => ( |
37 | is => 'rw', |
38 | isa => 'Int', |
39 | ); |
40 | |
41 | has with_tc_class_type => ( |
42 | is => 'rw', |
43 | isa => 'Foo', |
44 | ); |
45 | |
46 | has with_tc_array_of_int => ( |
47 | is => 'rw', |
48 | isa => 'ArrayRef[Int]', |
49 | ); |
32aaae09 |
50 | |
51 | has with_tc_duck_type => ( |
52 | is => 'rw', |
53 | isa => duck_type([qw(simple)]), |
54 | ); |
c6821d12 |
55 | __PACKAGE__->meta->make_immutable; |
56 | } |
57 | { |
58 | package MooseOne; |
59 | use Moose; |
32aaae09 |
60 | use Moose::Util::TypeConstraints; |
c6821d12 |
61 | has simple => ( |
62 | is => 'rw', |
63 | ); |
64 | has with_lazy => ( |
65 | is => 'rw', |
66 | lazy => 1, |
67 | default => 42, |
68 | ); |
69 | has with_tc => ( |
70 | is => 'rw', |
71 | isa => 'Int', |
72 | ); |
73 | has with_tc_class_type => ( |
74 | is => 'rw', |
75 | isa => 'Foo', |
76 | ); |
77 | has with_tc_array_of_int => ( |
78 | is => 'rw', |
79 | isa => 'ArrayRef[Int]', |
80 | ); |
32aaae09 |
81 | has with_tc_duck_type => ( |
82 | is => 'rw', |
83 | isa => duck_type([qw(simple)]), |
84 | ); |
c6821d12 |
85 | |
86 | __PACKAGE__->meta->make_immutable; |
87 | } |
88 | |
89 | use B qw(svref_2object); |
90 | |
91 | print "Moose/$Moose::VERSION (Class::MOP/$Class::MOP::VERSION)\n"; |
92 | print "Mouse/$Mouse::VERSION\n"; |
93 | print "Class::XSAccessor/$Class::XSAccessor::VERSION\n" if $cxsa_is_loaded; |
94 | |
95 | my $mi = MouseOne->new(); |
96 | my $mx = MooseOne->new(); |
97 | my $cx; |
98 | $cx = CXSA->new if $cxsa_is_loaded; |
99 | |
100 | print "\nSETTING for simple attributes\n"; |
101 | cmpthese -1 => { |
102 | 'Mouse' => sub{ |
103 | $mi->simple(10); |
104 | $mi->simple(10); |
105 | }, |
106 | 'Moose' => sub{ |
107 | $mx->simple(10); |
108 | $mx->simple(10); |
109 | }, |
110 | $cxsa_is_loaded ? ( |
111 | 'C::XSAccessor' => sub{ |
112 | $cx->simple(10); |
113 | $cx->simple(10); |
114 | }, |
115 | ) : (), |
116 | |
117 | }; |
118 | |
119 | print "\nSETTING for attributes with type constraints 'Int' (except for C::XSAccessor)\n"; |
120 | cmpthese -1 => { |
121 | 'Mouse' => sub{ |
122 | $mi->with_tc(10); |
123 | $mi->with_tc(10); |
124 | }, |
125 | 'Moose' => sub{ |
126 | $mx->with_tc(10); |
127 | $mx->with_tc(10); |
128 | }, |
129 | $cxsa_is_loaded ? ( |
130 | 'C::XSAccessor' => sub{ |
131 | $cx->simple(10); |
132 | $cx->simple(10); |
133 | }, |
134 | ) : (), |
135 | }; |
136 | |
137 | print "\nSETTING for attributes with type constraints 'Foo' (except for C::XSAccessor)\n"; |
138 | my $foo = Foo->new; |
139 | cmpthese -1 => { |
140 | 'Mouse' => sub{ |
141 | $mi->with_tc_class_type($foo); |
142 | $mi->with_tc_class_type($foo); |
143 | }, |
144 | 'Moose' => sub{ |
145 | $mx->with_tc_class_type($foo); |
146 | $mx->with_tc_class_type($foo); |
147 | }, |
148 | $cxsa_is_loaded ? ( |
149 | 'C::XSAccessor' => sub{ |
150 | $cx->simple($foo); |
151 | $cx->simple($foo); |
152 | }, |
153 | ) : (), |
154 | }; |
155 | |
156 | print "\nSETTING for attributes with type constraints 'ArrayRef[Int]' (except for C::XSAccessor)\n"; |
157 | |
158 | $foo = [10, 20]; |
159 | cmpthese -1 => { |
160 | 'Mouse' => sub{ |
161 | $mi->with_tc_array_of_int($foo); |
162 | $mi->with_tc_array_of_int($foo); |
163 | }, |
164 | 'Moose' => sub{ |
165 | $mx->with_tc_array_of_int($foo); |
166 | $mx->with_tc_array_of_int($foo); |
167 | }, |
168 | $cxsa_is_loaded ? ( |
169 | 'C::XSAccessor' => sub{ |
170 | $cx->simple($foo); |
171 | $cx->simple($foo); |
172 | }, |
173 | ) : (), |
174 | }; |
32aaae09 |
175 | |
176 | print "\nSETTING for attributes with type constraints duck_type() (except for C::XSAccessor)\n"; |
177 | |
178 | $foo = MouseOne->new(); |
179 | cmpthese -1 => { |
180 | 'Mouse' => sub{ |
181 | $mi->with_tc_duck_type($foo); |
182 | $mi->with_tc_duck_type($foo); |
183 | }, |
184 | 'Moose' => sub{ |
185 | $mx->with_tc_duck_type($foo); |
186 | $mx->with_tc_duck_type($foo); |
187 | }, |
188 | $cxsa_is_loaded ? ( |
189 | 'C::XSAccessor' => sub{ |
190 | $cx->simple($foo); |
191 | $cx->simple($foo); |
192 | }, |
193 | ) : (), |
194 | }; |