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 | } |
46 | __PACKAGE__->mk_accessors('caf'); |
47 | |
48 | { |
49 | require Class::Accessor::Fast::XS; |
50 | local @ISA = 'Class::Accessor::Fast::XS'; |
51 | __PACKAGE__->mk_accessors ('caf_xs'); |
52 | } |
53 | |
71eea8e1 |
54 | { |
55 | require Class::XSAccessor::Compat; |
56 | local @ISA = 'Class::XSAccessor::Compat'; |
57 | __PACKAGE__->mk_accessors ('caf_xsa'); |
58 | } |
59 | |
8019c4d8 |
60 | sub handmade { |
61 | @_ > 1 ? $_[0]->{handmade} = $_[1] : $_[0]->{handmade}; |
62 | } |
63 | |
64 | } |
65 | my $bench_objs = { |
66 | base => bless ({}, 'Bench::Accessor') |
67 | }; |
68 | |
69 | sub _add_moose_task { |
70 | my ($tasks, $name, $class) = @_; |
71 | my $meth = lc($name); |
72 | |
73 | my $gen_class = "Bench::Accessor::$class"; |
74 | eval <<"EOC"; |
75 | package $gen_class; |
76 | use $class; |
77 | has $meth => (is => 'rw'); |
af71d687 |
78 | # some moosey thingies can not do this |
79 | eval { __PACKAGE__->meta->make_immutable }; |
8019c4d8 |
80 | EOC |
81 | |
82 | $bench_objs->{$name} = $gen_class->new; |
83 | _add_task ($tasks, $name, $meth, $name); |
84 | } |
85 | |
86 | sub _add_task { |
87 | my ($tasks, $name, $meth, $slot) = @_; |
88 | |
af71d687 |
89 | my $perl; |
90 | for (1 .. 1000) { |
91 | $perl .= " |
92 | \$bench_objs->{$slot}->$meth($_); |
93 | \$bench_objs->{$slot}->$meth(\$bench_objs->{$slot}->$meth + $_); |
94 | "; |
95 | } |
96 | |
97 | $tasks->{$name} = eval "sub { $perl } "; |
8019c4d8 |
98 | } |
99 | |
100 | my $tasks = { |
101 | # 'direct' => sub { |
102 | # $bench_objs->{base}{direct} = 1; |
103 | # $bench_objs->{base}{direct} = $bench_objs->{base}{direct} + 1; |
104 | # } |
105 | }; |
106 | |
71eea8e1 |
107 | for (qw/CAG CAG_XS CAF CAF_XS CAF_XSA XSA HANDMADE/) { |
8019c4d8 |
108 | _add_task ($tasks, $_, lc($_), 'base'); |
109 | } |
110 | |
111 | my $moose_based = { |
112 | moOse => 'Moose', |
af71d687 |
113 | moo_XS => 'Moo', |
114 | moUse_XS => 'Mouse', |
115 | moUse => 'Mousse', |
8019c4d8 |
116 | }; |
117 | for (keys %$moose_based) { |
118 | _add_moose_task ($tasks, $_, $moose_based->{$_}) |
119 | } |
120 | |
af71d687 |
121 | { |
122 | no warnings 'once'; |
123 | local $Method::Generate::Accessor::CAN_HAZ_XS = 0; |
124 | _add_moose_task ($tasks, moo => 'Moo'); |
125 | } |
8019c4d8 |
126 | |
af71d687 |
127 | for (1 .. 5) { |
8019c4d8 |
128 | print "Perl $], take $_:\n"; |
129 | cmpthese ( -1, $tasks ); |
130 | print "\n"; |
131 | } |