Commit | Line | Data |
8019c4d8 |
1 | use strictures 1; |
2 | |
3 | BEGIN { |
4 | my @missing; |
5 | for (qw/ |
6 | Class::Accessor::Grouped |
7 | Class::XSAccessor |
8 | Class::Accessor::Fast |
9 | Class::Accessor::Fast::XS |
71eea8e1 |
10 | Class::XSAccessor::Compat |
8019c4d8 |
11 | Moose |
12 | Mouse |
af71d687 |
13 | Mousse |
14 | Moo |
8019c4d8 |
15 | /) { |
16 | eval "require $_" or push @missing, $_; |
17 | } |
18 | |
19 | if (@missing) { |
20 | die sprintf "Missing modules necessary for benchmark:\n\n%s\n\n", |
21 | join ("\n", @missing); |
22 | } |
23 | } |
24 | |
25 | |
26 | use Benchmark qw/:hireswallclock cmpthese/; |
27 | |
28 | { |
29 | package Bench::Accessor; |
30 | |
31 | use strictures 1; |
32 | |
33 | our @ISA; |
34 | |
35 | use base qw/Class::Accessor::Grouped Class::Accessor::Fast/; |
36 | use Class::XSAccessor { accessors => [ 'xsa' ] }; |
37 | |
38 | { |
39 | local $Class::Accessor::Grouped::USE_XS = 0; |
40 | __PACKAGE__->mk_group_accessors ('simple', 'cag'); |
41 | } |
42 | { |
43 | local $Class::Accessor::Grouped::USE_XS = 1; |
44 | __PACKAGE__->mk_group_accessors ('simple', 'cag_xs'); |
45 | } |
52e85101 |
46 | |
47 | __PACKAGE__->mk_group_accessors ('inherited', 'cag_inh'); |
48 | __PACKAGE__->cag_inh('initial value'); |
49 | |
8019c4d8 |
50 | __PACKAGE__->mk_accessors('caf'); |
51 | |
52 | { |
53 | require Class::Accessor::Fast::XS; |
54 | local @ISA = 'Class::Accessor::Fast::XS'; |
55 | __PACKAGE__->mk_accessors ('caf_xs'); |
56 | } |
57 | |
71eea8e1 |
58 | { |
59 | require Class::XSAccessor::Compat; |
60 | local @ISA = 'Class::XSAccessor::Compat'; |
61 | __PACKAGE__->mk_accessors ('caf_xsa'); |
62 | } |
63 | |
8019c4d8 |
64 | sub handmade { |
65 | @_ > 1 ? $_[0]->{handmade} = $_[1] : $_[0]->{handmade}; |
66 | } |
67 | |
68 | } |
69 | my $bench_objs = { |
70 | base => bless ({}, 'Bench::Accessor') |
71 | }; |
72 | |
73 | sub _add_moose_task { |
74 | my ($tasks, $name, $class) = @_; |
75 | my $meth = lc($name); |
76 | |
77 | my $gen_class = "Bench::Accessor::$class"; |
78 | eval <<"EOC"; |
79 | package $gen_class; |
80 | use $class; |
81 | has $meth => (is => 'rw'); |
af71d687 |
82 | # some moosey thingies can not do this |
83 | eval { __PACKAGE__->meta->make_immutable }; |
8019c4d8 |
84 | EOC |
85 | |
86 | $bench_objs->{$name} = $gen_class->new; |
87 | _add_task ($tasks, $name, $meth, $name); |
88 | } |
89 | |
90 | sub _add_task { |
91 | my ($tasks, $name, $meth, $slot) = @_; |
92 | |
52e85101 |
93 | # we precompile the desired amount of loops so that the loop itself |
94 | # does not get in the way with some sort of optimization or whatnot |
95 | |
af71d687 |
96 | my $perl; |
97 | for (1 .. 1000) { |
98 | $perl .= " |
52e85101 |
99 | \$::init_val = \$bench_objs->{$slot}->$meth; |
af71d687 |
100 | \$bench_objs->{$slot}->$meth($_); |
101 | \$bench_objs->{$slot}->$meth(\$bench_objs->{$slot}->$meth + $_); |
102 | "; |
103 | } |
104 | |
52e85101 |
105 | $tasks->{$name} = eval "sub { $perl } " or die $@; |
8019c4d8 |
106 | } |
107 | |
108 | my $tasks = { |
109 | # 'direct' => sub { |
110 | # $bench_objs->{base}{direct} = 1; |
111 | # $bench_objs->{base}{direct} = $bench_objs->{base}{direct} + 1; |
112 | # } |
113 | }; |
114 | |
52e85101 |
115 | for (qw/CAG CAG_XS CAG_INH CAF CAF_XS CAF_XSA XSA HANDMADE/) { |
8019c4d8 |
116 | _add_task ($tasks, $_, lc($_), 'base'); |
117 | } |
118 | |
119 | my $moose_based = { |
120 | moOse => 'Moose', |
af71d687 |
121 | moo_XS => 'Moo', |
122 | moUse_XS => 'Mouse', |
123 | moUse => 'Mousse', |
8019c4d8 |
124 | }; |
125 | for (keys %$moose_based) { |
126 | _add_moose_task ($tasks, $_, $moose_based->{$_}) |
127 | } |
128 | |
af71d687 |
129 | { |
130 | no warnings 'once'; |
131 | local $Method::Generate::Accessor::CAN_HAZ_XS = 0; |
132 | _add_moose_task ($tasks, moo => 'Moo'); |
133 | } |
8019c4d8 |
134 | |
af71d687 |
135 | for (1 .. 5) { |
8019c4d8 |
136 | print "Perl $], take $_:\n"; |
137 | cmpthese ( -1, $tasks ); |
138 | print "\n"; |
139 | } |