3 use Benchmark qw/:hireswallclock cmpthese/;
4 use Getopt::Long::Descriptive;
9 ($opts, $usage) = describe_options(
11 [ 'help|h' => 'Print usage message and exit' ],
12 [ 'classes|c:i' => 'How many classes to create per benchmark cycle (def 10)', { default => 10 } ],
13 [ 'accessors|a:i' => 'How many accessors to create per class (def 100)', { default => 100 } ],
14 [ 'pregenerate|p:i' => 'For how many maximum benchmark cycles should we prepare (def 1000)', { default => 1000 } ],
15 [ 'unique|u' => 'Make accessor names globally unique (instead of just per class)' ],
16 [ 'bench|b:s' => 'Which benchmarks to run (all|xs|pp)', { default => 'all', regex => qr/^(?:all|xs|pp)$/ } ],
17 { getopt_conf => [qw/gnu_getopt bundling_override no_ignore_case/] },
20 # can not change this runtime, thus in-block
21 $ENV{MOUSE_PUREPERL} = 1 if $opts->{bench} eq 'pp';
29 eval "require $_" or push @missing, $_;
33 die sprintf "Missing modules necessary for benchmark:\n\n%s\n\n",
34 join ("\n", @missing);
38 use Method::Generate::Accessor; # need to pre-load for the XS shutoff to work
40 $usage->die if $opts->{help};
45 if ($opts->{bench} =~ /all|pp/) {
47 local $Method::Generate::Accessor::CAN_HAZ_XS = 0;
48 _add_moosey_has (moo => 'Moo');
51 _add_moosey_has (moose => 'Moose');
52 _add_moosey_has (mouse => 'Mouse')
53 if $ENV{MOUSE_PUREPERL};
56 if ($opts->{bench} =~ /all|xs/) {
58 local $Method::Generate::Accessor::CAN_HAZ_XS = 1;
59 _add_moosey_has (moo_XS => 'Moo');
61 _add_moosey_has (mouse_XS => 'Mouse')
62 unless $ENV{MOUSE_PUREPERL};
65 # run each task once, prime whatever caches there may be
66 $_->() for values %$tasks;
70 print "Perl $], take $_:\n";
71 cmpthese ( -1, $tasks );
78 my ($name, $base) = @_;
82 # need to pre-gen stuff so that the class names will differ for every bench run
83 for (1 .. $opts->{pregenerate}) {
85 for ( 1.. $opts->{classes} ) {
86 my $class = "Bench::${base}::" . ++$counters->{class};
87 $perl .= "package $class; use $base;";
88 for ( 1.. $opts->{accessors} ) {
89 my $attr = 'attribute_' . ++$counters->{acc};
90 $perl .= "has $attr => ( is => rw );";
93 $counters->{accessors} = 0
94 unless $opts->{unique};
97 push @for_eval, $perl;
100 $tasks->{$name} = sub {
101 my $code = shift @for_eval
102 or die "Ran out of pre-generated stuff, raise -p\n";