MOAR bench
[gitmo/Moo.git] / benchmark / object_factory
CommitLineData
421104c9 1use strictures 1;
2
3use Benchmark qw/:hireswallclock cmpthese/;
4use Getopt::Long::Descriptive;
5
6use Config;
7$ENV{PERL5LIB} = join ($Config{path_sep}, @INC);
8
9
10my ($opts, $usage);
11BEGIN {
12 ($opts, $usage) = describe_options(
13 '%c: %o' =>
14 [ 'help|h' => 'Print usage message and exit' ],
15 [ 'bench|b:s' => 'Which benchmarks to run (all|xs|pp)', { default => 'all', regex => qr/^(?:all|xs|pp)$/ } ],
16 [ 'iterations|i:i' => 'How many iterations in each bench run (def 1000)', { default => 1000 } ],
17 [ 'reuse|r' => 'Reuse the object between benchmark runs' ],
18 { getopt_conf => [qw/gnu_getopt bundling_override no_ignore_case/] },
19 );
20
21 # can not change this runtime, thus in-block
22 $ENV{MOUSE_PUREPERL} = 1 if $opts->{bench} eq 'pp';
23
24 my @missing;
25 for (qw/
26 Moose
27 Moo
28 Mouse
29 /) {
30 eval "require $_" or push @missing, $_;
31 }
32
33 if (@missing) {
34 die sprintf "Missing modules necessary for benchmark:\n\n%s\n\n",
35 join ("\n", @missing);
36 }
37}
38
39use Method::Generate::Accessor; # need to pre-load for the XS shut-off to work
40
41$usage->die if $opts->{help};
42
43my $attrs_to_bench = {
44 plain => q|is => 'rw' |,
45 lazy_default => q|is => 'rw', lazy => 1, default => sub { {} } |,
46 lazy_default_qsub => q|is => 'rw', lazy => 1, default => Sub::Quote::quote_sub q{ {} } |,
47};
48
49my $class_types;
50
51if ($opts->{bench} =~ /all|pp/) {
52 {
53 local $Method::Generate::Accessor::CAN_HAZ_XS = 0;
54 _add_moosey_has (moo => 'Moo');
55 }
56
57 _add_moosey_has (moose => 'Moose');
58 _add_moosey_has (mouse => 'Mouse')
59 if $ENV{MOUSE_PUREPERL};
60}
61
62if ($opts->{bench} =~ /all|xs/) {
63 {
64 local $Method::Generate::Accessor::CAN_HAZ_XS = 1;
65 _add_moosey_has (moo_XS => 'Moo');
66 }
67 _add_moosey_has (mouse_XS => 'Mouse')
68 unless $ENV{MOUSE_PUREPERL};
69}
70
71
72# Actual Benchmarking
73for (1, 2) {
74 print "Perl $], take $_:\n";
75
76 my $objects;
77
78 print "\n\nBenching new()\n====================\n";
79
80 cmpthese ( -1, { map {
81 my $type = $_;
82 "${type}->new" => sub {
83 $objects->{$type} = $class_types->{$type}->new
84 for (1 .. $opts->{iterations});
85 }
86 } keys %$class_types } );
87
88 for my $attr (keys %$attrs_to_bench) {
89 print "\n\nBenching $attr\n====================\n";
90
91 cmpthese ( -1, { map {
92 my $type = $_;
93 "${type}->$attr" => sub {
94 $objects->{$type} = $class_types->{$type}->new
95 unless $opts->{reuse};
96
97 for (1 .. $opts->{iterations} ) {
98 my $init = $objects->{$type}->$attr;
99 $objects->{$type}->$attr('foo');
100 my $set = $objects->{$type}->$attr;
101 }
102 }
103 } keys %$objects } );
104 }
105}
106
107exit 0; # the end
108
109sub _add_moosey_has {
110 my ($name, $base) = @_;
111
112 my $class = "Bench::${name}";
113
114 my $perl = "package $class; use $base;";
115
116 for my $attr (keys %$attrs_to_bench) {
117 $perl .= "has $attr => ($attrs_to_bench->{$attr});";
118
119 $class_types->{$name} = $class;
120 }
121
122 $perl .= 'eval { __PACKAGE__->meta->make_immutable };';
123
124 eval $perl;
125 die $@ if $@;
126}