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 |
13 | /) { |
14 | eval "require $_" or push @missing, $_; |
15 | } |
16 | |
17 | if (@missing) { |
18 | die sprintf "Missing modules necessary for benchmark:\n\n%s\n\n", |
19 | join ("\n", @missing); |
20 | } |
21 | } |
22 | |
23 | |
24 | use Benchmark qw/:hireswallclock cmpthese/; |
25 | |
26 | { |
27 | package Bench::Accessor; |
28 | |
29 | use strictures 1; |
30 | |
31 | our @ISA; |
32 | |
33 | use base qw/Class::Accessor::Grouped Class::Accessor::Fast/; |
34 | use Class::XSAccessor { accessors => [ 'xsa' ] }; |
35 | |
36 | { |
37 | local $Class::Accessor::Grouped::USE_XS = 0; |
38 | __PACKAGE__->mk_group_accessors ('simple', 'cag'); |
39 | } |
40 | { |
41 | local $Class::Accessor::Grouped::USE_XS = 1; |
42 | __PACKAGE__->mk_group_accessors ('simple', 'cag_xs'); |
43 | } |
44 | __PACKAGE__->mk_accessors('caf'); |
45 | |
46 | { |
47 | require Class::Accessor::Fast::XS; |
48 | local @ISA = 'Class::Accessor::Fast::XS'; |
49 | __PACKAGE__->mk_accessors ('caf_xs'); |
50 | } |
51 | |
71eea8e1 |
52 | { |
53 | require Class::XSAccessor::Compat; |
54 | local @ISA = 'Class::XSAccessor::Compat'; |
55 | __PACKAGE__->mk_accessors ('caf_xsa'); |
56 | } |
57 | |
8019c4d8 |
58 | sub handmade { |
59 | @_ > 1 ? $_[0]->{handmade} = $_[1] : $_[0]->{handmade}; |
60 | } |
61 | |
62 | } |
63 | my $bench_objs = { |
64 | base => bless ({}, 'Bench::Accessor') |
65 | }; |
66 | |
67 | sub _add_moose_task { |
68 | my ($tasks, $name, $class) = @_; |
69 | my $meth = lc($name); |
70 | |
71 | my $gen_class = "Bench::Accessor::$class"; |
72 | eval <<"EOC"; |
73 | package $gen_class; |
74 | use $class; |
75 | has $meth => (is => 'rw'); |
76 | __PACKAGE__->meta->make_immutable; |
77 | EOC |
78 | |
79 | $bench_objs->{$name} = $gen_class->new; |
80 | _add_task ($tasks, $name, $meth, $name); |
81 | } |
82 | |
83 | sub _add_task { |
84 | my ($tasks, $name, $meth, $slot) = @_; |
85 | |
86 | $tasks->{$name} = eval "sub { |
87 | for (my \$i = 0; \$i < 100; \$i++) { |
88 | \$bench_objs->{$slot}->$meth(1); |
89 | \$bench_objs->{$slot}->$meth(\$bench_objs->{$slot}->$meth + 1); |
90 | } |
91 | }"; |
92 | } |
93 | |
94 | my $tasks = { |
95 | # 'direct' => sub { |
96 | # $bench_objs->{base}{direct} = 1; |
97 | # $bench_objs->{base}{direct} = $bench_objs->{base}{direct} + 1; |
98 | # } |
99 | }; |
100 | |
71eea8e1 |
101 | for (qw/CAG CAG_XS CAF CAF_XS CAF_XSA XSA HANDMADE/) { |
8019c4d8 |
102 | _add_task ($tasks, $_, lc($_), 'base'); |
103 | } |
104 | |
105 | my $moose_based = { |
106 | moOse => 'Moose', |
107 | ($ENV{MOUSE_PUREPERL} ? 'moUse' : 'moUse_XS') => 'Mouse', |
108 | }; |
109 | for (keys %$moose_based) { |
110 | _add_moose_task ($tasks, $_, $moose_based->{$_}) |
111 | } |
112 | |
113 | |
114 | for (1, 2) { |
115 | print "Perl $], take $_:\n"; |
116 | cmpthese ( -1, $tasks ); |
117 | print "\n"; |
118 | } |