{ getopt_conf => [qw/gnu_getopt bundling_override no_ignore_case/] },
);
- # can not change this runtime, thus in-block
- $ENV{MOUSE_PUREPERL} = 1 if $opts->{bench} eq 'pp';
-
my @missing;
for (qw/
Moose
Moo
Mouse
+ Mousse
+ Class::XSAccessor
/) {
eval "require $_" or push @missing, $_;
}
my $attrs_to_bench = {
plain => q|is => 'rw' |,
+ ro => q|is => 'ro' |,
+ default => q|is => 'rw', default => sub { {} } |,
lazy_default => q|is => 'rw', lazy => 1, default => sub { {} } |,
lazy_default_qsub => q|is => 'rw', lazy => 1, default => Sub::Quote::quote_sub q{ {} } |,
};
}
_add_moosey_has (moose => 'Moose');
- _add_moosey_has (mouse => 'Mouse')
- if $ENV{MOUSE_PUREPERL};
+ _add_moosey_has (mouse => 'Mousse')
}
if ($opts->{bench} =~ /all|xs/) {
+ if (! $Method::Generate::Accessor::CAN_HAZ_XS)
{
- local $Method::Generate::Accessor::CAN_HAZ_XS = 1;
- _add_moosey_has (moo_XS => 'Moo');
+ die "Requested XS benchmarks but XS isn't available in Method::Generate::Accessor";
}
+
+ _add_moosey_has (moo_XS => 'Moo');
_add_moosey_has (mouse_XS => 'Mouse')
- unless $ENV{MOUSE_PUREPERL};
}
my $objects;
- print "\n\nBenching new()\n====================\n";
-
- cmpthese ( -1, { map {
- my $type = $_;
- "${type}->new" => sub {
- $objects->{$type} = $class_types->{$type}->new
- for (1 .. $opts->{iterations});
+ for my $use_attrs (0, 1) {
+ for my $attr (keys %$attrs_to_bench) {
+ printf "\n\nBenching %s ( %s )\n====================\n",
+ $attr,
+ $use_attrs
+ ? ($opts->{reuse} ? '' : 'new() and ' ) . 'get/set/get cycle'
+ : 'new() only'
+ ,
+ ;
+
+ cmpthese ( -1, { map {
+ my $type = $_;
+ "${type}->$attr" => sub {
+ $objects->{$type} = $class_types->{$type}->new
+ unless ( $use_attrs && $opts->{reuse} );
+
+ for (1 .. $opts->{iterations} ) {
+ my $init = $objects->{$type}->$attr;
+ $objects->{$type}->$attr('foo') unless $attr eq 'ro';
+ my $set = $objects->{$type}->$attr;
+ }
+ };
+ } keys %$class_types } );
}
- } keys %$class_types } );
-
- for my $attr (keys %$attrs_to_bench) {
- print "\n\nBenching $attr\n====================\n";
-
- cmpthese ( -1, { map {
- my $type = $_;
- "${type}->$attr" => sub {
- $objects->{$type} = $class_types->{$type}->new
- unless $opts->{reuse};
-
- for (1 .. $opts->{iterations} ) {
- my $init = $objects->{$type}->$attr;
- $objects->{$type}->$attr('foo');
- my $set = $objects->{$type}->$attr;
- }
- }
- } keys %$objects } );
}
}