-use strictures 1;
-
BEGIN {
my @missing;
for (qw/
+ strictures
Class::Accessor::Grouped
Class::XSAccessor
Class::Accessor::Fast
Class::Accessor::Fast::XS
+ Class::XSAccessor::Compat
Moose
Mouse
+ Mousse
+ Moo
+ Dumbbench
/) {
eval "require $_" or push @missing, $_;
}
}
-use Benchmark qw/:hireswallclock cmpthese/;
+use strictures 1;
+use Benchmark::Dumb ':all';
{
+ package Bench::Accessor::GrandParent;
+ use strictures 1;
+
+ use base 'Class::Accessor::Grouped';
+ __PACKAGE__->mk_group_accessors ('inherited', 'cag_inhp');
+ __PACKAGE__->cag_inhp('initial parent value');
+
+ package Bench::Accessor::Parent;
+ use strictures 1;
+ use base 'Bench::Accessor::GrandParent';
+
package Bench::Accessor;
use strictures 1;
our @ISA;
- use base qw/Class::Accessor::Grouped Class::Accessor::Fast/;
+ use base qw/Bench::Accessor::Parent Class::Accessor::Grouped Class::Accessor::Fast/;
use Class::XSAccessor { accessors => [ 'xsa' ] };
{
local $Class::Accessor::Grouped::USE_XS = 1;
__PACKAGE__->mk_group_accessors ('simple', 'cag_xs');
}
+
+ __PACKAGE__->mk_group_accessors ('inherited', 'cag_inh');
+ __PACKAGE__->cag_inh('initial value');
+
__PACKAGE__->mk_accessors('caf');
{
__PACKAGE__->mk_accessors ('caf_xs');
}
+ {
+ require Class::XSAccessor::Compat;
+ local @ISA = 'Class::XSAccessor::Compat';
+ __PACKAGE__->mk_accessors ('caf_xsa');
+ }
+
sub handmade {
+ no warnings;
+ no strict;
@_ > 1 ? $_[0]->{handmade} = $_[1] : $_[0]->{handmade};
}
package $gen_class;
use $class;
has $meth => (is => 'rw');
-__PACKAGE__->meta->make_immutable;
+# some moosey thingies can not do this
+eval { __PACKAGE__->meta->make_immutable };
EOC
$bench_objs->{$name} = $gen_class->new;
sub _add_task {
my ($tasks, $name, $meth, $slot) = @_;
- $tasks->{$name} = eval "sub {
- for (my \$i = 0; \$i < 100; \$i++) {
- \$bench_objs->{$slot}->$meth(1);
- \$bench_objs->{$slot}->$meth(\$bench_objs->{$slot}->$meth + 1);
- }
- }";
+ # we precompile the desired amount of loops so that the loop itself
+ # does not get in the way with some sort of optimization or whatnot
+
+ use Devel::Dwarn;
+# Dwarn { $meth => $bench_objs->{$slot}->can($meth) };
+
+ my $perl;
+ for (1 .. 100) {
+ $perl .= "
+ \$::init_val = \$bench_objs->{$slot}->$meth;
+ \$bench_objs->{$slot}->$meth($_);
+ \$bench_objs->{$slot}->$meth(\$bench_objs->{$slot}->$meth + $_);
+ \$bench_objs->{$slot}->$meth(undef);
+ ";
+ }
+
+ $tasks->{$name} = eval "sub { use warnings; use strict; $perl } " or die $@;
+
+ # prime things up (have the task run a couple times)
+ $tasks->{$name}->() for (1..5);
}
my $tasks = {
# }
};
-for (qw/CAG CAG_XS CAF CAF_XS XSA HANDMADE/) {
+for (qw/CAG CAG_XS CAG_INH CAG_INHP CAF CAF_XS CAF_XSA XSA HANDMADE/) {
_add_task ($tasks, $_, lc($_), 'base');
}
my $moose_based = {
moOse => 'Moose',
- ($ENV{MOUSE_PUREPERL} ? 'moUse' : 'moUse_XS') => 'Mouse',
+ moo_XS => 'Moo',
+ moUse_XS => 'Mouse',
+ moUse => 'Mousse',
};
for (keys %$moose_based) {
_add_moose_task ($tasks, $_, $moose_based->{$_})
}
+{
+ no warnings 'once';
+ local $Method::Generate::Accessor::CAN_HAZ_XS = 0;
+ _add_moose_task ($tasks, moo => 'Moo');
+}
+
+#delete $tasks->{$_} for grep { $_ !~ /CAG/ } keys %$tasks;
-for (1, 2) {
+for (1 .. 3) {
print "Perl $], take $_:\n";
- cmpthese ( -1, $tasks );
+# DB::enable_profile();
+ cmpthese ( '50.0001', $tasks );
+# DB::disable_profile();
print "\n";
}