diff options
Diffstat (limited to 'benchmarks')
26 files changed, 1285 insertions, 0 deletions
diff --git a/benchmarks/caf_vs_moose.pl b/benchmarks/caf_vs_moose.pl new file mode 100644 index 0000000..ef6ef28 --- /dev/null +++ b/benchmarks/caf_vs_moose.pl @@ -0,0 +1,85 @@ +#!perl + +### MODULES + +{ + package PlainMoose; + use Moose; + has foo => (is => 'rw'); +} +{ + package MooseImmutable; + use Moose; + has foo => (is => 'rw'); + __PACKAGE__->meta->make_immutable(); +} +{ + package MooseImmutable::NoConstructor; + use Moose; + has foo => (is => 'rw'); + __PACKAGE__->meta->make_immutable(inline_constructor => 0); +} +{ + package ClassAccessorFast; + use warnings; + use strict; + use base 'Class::Accessor::Fast'; + __PACKAGE__->mk_accessors(qw(foo)); +} + +use Benchmark qw(cmpthese); +use Benchmark ':hireswallclock'; + +my $moose = PlainMoose->new; +my $moose_immut = MooseImmutable->new; +my $moose_immut_no_const = MooseImmutable::NoConstructor->new; +my $caf = ClassAccessorFast->new; + +my $acc_rounds = 100_000; +my $ins_rounds = 100_000; + +print "\nSETTING\n"; +cmpthese($acc_rounds, { + Moose => sub { $moose->foo(23) }, + MooseImmutable => sub { $moose_immut->foo(23) }, + MooseImmutableNoConstructor => sub { $moose_immut_no_const->foo(23) }, + ClassAccessorFast => sub { $caf->foo(23) }, +}, 'noc'); + +print "\nGETTING\n"; +cmpthese($acc_rounds, { + Moose => sub { $moose->foo }, + MooseImmutable => sub { $moose_immut->foo }, + MooseImmutableNoConstructor => sub { $moose_immut_no_const->foo }, + ClassAccessorFast => sub { $caf->foo }, +}, 'noc'); + +my (@moose, @moose_immut, @moose_immut_no_const, @caf_stall); +print "\nCREATION\n"; +cmpthese($ins_rounds, { + Moose => sub { push @moose, PlainMoose->new(foo => 23) }, + MooseImmutable => sub { push @moose_immut, MooseImmutable->new(foo => 23) }, + MooseImmutableNoConstructor => sub { push @moose_immut_no_const, MooseImmutable::NoConstructor->new(foo => 23) }, + ClassAccessorFast => sub { push @caf_stall, ClassAccessorFast->new({foo => 23}) }, +}, 'noc'); + +my ( $moose_idx, $moose_immut_idx, $moose_immut_no_const_idx, $caf_idx ) = ( 0, 0, 0, 0 ); +print "\nDESTRUCTION\n"; +cmpthese($ins_rounds, { + Moose => sub { + $moose[$moose_idx] = undef; + $moose_idx++; + }, + MooseImmutable => sub { + $moose_immut[$moose_immut_idx] = undef; + $moose_immut_idx++; + }, + MooseImmutableNoConstructor => sub { + $moose_immut_no_const[$moose_immut_no_const_idx] = undef; + $moose_immut_no_const_idx++; + }, + ClassAccessorFast => sub { + $caf_stall[$caf_idx] = undef; + $caf_idx++; + }, +}, 'noc'); diff --git a/benchmarks/cmop/all.yml b/benchmarks/cmop/all.yml new file mode 100644 index 0000000..f0d5758 --- /dev/null +++ b/benchmarks/cmop/all.yml @@ -0,0 +1,29 @@ +--- +- name: Point classes + classes: + - 'MOP::Point' + - 'MOP::Point3D' + - 'MOP::Immutable::Point' + - 'MOP::Immutable::Point3D' + - 'MOP::Installed::Point' + - 'MOP::Installed::Point3D' + - 'Plain::Point' + - 'Plain::Point3D' + benchmarks: + - class: 'Bench::Construct' + name: object construction + args: + y: 137 + - class: 'Bench::Accessor' + name: accessor get + construct: + x: 4 + y: 6 + accessor: x + - class: 'Bench::Accessor' + name: accessor set + construct: + x: 4 + y: 6 + accessor: x + accessor_args: [ 5 ] diff --git a/benchmarks/cmop/foo.pl b/benchmarks/cmop/foo.pl new file mode 100755 index 0000000..e99365b --- /dev/null +++ b/benchmarks/cmop/foo.pl @@ -0,0 +1,5 @@ +#!perl -wd:NYTProf +# a moose using script for profiling +# Usage: perl bench/profile.pl + +require KiokuDB; diff --git a/benchmarks/cmop/lib/Bench/Accessor.pm b/benchmarks/cmop/lib/Bench/Accessor.pm new file mode 100644 index 0000000..3f30239 --- /dev/null +++ b/benchmarks/cmop/lib/Bench/Accessor.pm @@ -0,0 +1,49 @@ +#!/usr/bin/perl + +package Bench::Accessor; +use Moose; +use Moose::Util::TypeConstraints; + +eval { +coerce ArrayRef + => from HashRef + => via { [ %$_ ] }; +}; + +has class => ( + isa => "Str", + is => "ro", +); + +has construct => ( + isa => "ArrayRef", + is => "ro", + auto_deref => 1, + coerce => 1, +); + +has accessor => ( + isa => "Str", + is => "ro", +); + +has accessor_args => ( + isa => "ArrayRef", + is => "ro", + auto_deref => 1, + coerce => 1, +); + +sub code { + my $self = shift; + + my $obj = $self->class->new( $self->construct ); + my @accessor_args = $self->accessor_args; + my $accessor = $self->accessor; + + sub { $obj->$accessor( @accessor_args ) }; +} + +__PACKAGE__; + +__END__ diff --git a/benchmarks/cmop/lib/Bench/Construct.pm b/benchmarks/cmop/lib/Bench/Construct.pm new file mode 100644 index 0000000..c290304 --- /dev/null +++ b/benchmarks/cmop/lib/Bench/Construct.pm @@ -0,0 +1,36 @@ +#!/usr/bin/perl + +package Bench::Construct; +use Moose; +use Moose::Util::TypeConstraints; + +has class => ( + isa => "Str", + is => "ro", +); + +eval { +coerce ArrayRef + => from HashRef + => via { [ %$_ ] }; +}; + +has args => ( + isa => "ArrayRef", + is => "ro", + auto_deref => 1, + coerce => 1, +); + +sub code { + my $self = shift; + + my $class = $self->class; + my @args = $self->args; + + sub { my $obj = $class->new( @args ) } +} + +__PACKAGE__; + +__END__ diff --git a/benchmarks/cmop/lib/Bench/Run.pm b/benchmarks/cmop/lib/Bench/Run.pm new file mode 100644 index 0000000..09ac1b6 --- /dev/null +++ b/benchmarks/cmop/lib/Bench/Run.pm @@ -0,0 +1,55 @@ +#!/usr/bin/perl + +package Bench::Run; +use Moose; + +use Benchmark qw/:hireswallclock :all/; + +has classes => ( + isa => "ArrayRef", + is => "rw", + auto_deref => 1, +); + +has benchmarks => ( + isa => "ArrayRef", + is => "rw", + auto_deref => 1, +); + +has min_time => ( + isa => "Num", + is => "rw", + default => 5, +); + +sub run { + my $self = shift; + + foreach my $bench ( $self->benchmarks ) { + my $bench_class = delete $bench->{class}; + my $name = delete $bench->{name} || $bench_class; + my @bench_args = %$bench; + + eval "require $bench_class"; + die $@ if $@; + + my %res; + + foreach my $class ( $self->classes ) { + eval "require $class"; + die $@ if $@; + + my $b = $bench_class->new( @bench_args, class => $class ); + $res{$class} = countit( $self->min_time, $b->code ); + } + + print "- $name:\n"; + cmpthese( \%res ); + print "\n"; + } +} + +__PACKAGE__; + +__END__ diff --git a/benchmarks/cmop/lib/MOP/Immutable/Point.pm b/benchmarks/cmop/lib/MOP/Immutable/Point.pm new file mode 100644 index 0000000..a0d7c90 --- /dev/null +++ b/benchmarks/cmop/lib/MOP/Immutable/Point.pm @@ -0,0 +1,21 @@ + +package MOP::Immutable::Point; + +use strict; +use warnings; +use metaclass; + +__PACKAGE__->meta->add_attribute('x' => (accessor => 'x', default => 10)); +__PACKAGE__->meta->add_attribute('y' => (accessor => 'y')); + +sub clear { + my $self = shift; + $self->x(0); + $self->y(0); +} + +__PACKAGE__->meta->make_immutable; + +1; + +__END__ diff --git a/benchmarks/cmop/lib/MOP/Immutable/Point3D.pm b/benchmarks/cmop/lib/MOP/Immutable/Point3D.pm new file mode 100644 index 0000000..bf33cf0 --- /dev/null +++ b/benchmarks/cmop/lib/MOP/Immutable/Point3D.pm @@ -0,0 +1,22 @@ + +package MOP::Immutable::Point3D; + +use strict; +use warnings; +use metaclass; + +use base 'MOP::Point'; + +__PACKAGE__->meta->add_attribute('z' => (accessor => 'z')); + +sub clear { + my $self = shift; + $self->SUPER::clear(); + $self->z(0); +} + +__PACKAGE__->meta->make_immutable; + +1; + +__END__ diff --git a/benchmarks/cmop/lib/MOP/Installed/Point.pm b/benchmarks/cmop/lib/MOP/Installed/Point.pm new file mode 100644 index 0000000..9b6e6cf --- /dev/null +++ b/benchmarks/cmop/lib/MOP/Installed/Point.pm @@ -0,0 +1,26 @@ + +use lib reverse @INC; + +package MOP::Installed::Point; + +use strict; +use warnings; +use metaclass; + +__PACKAGE__->meta->add_attribute('x' => (accessor => 'x', default => 10)); +__PACKAGE__->meta->add_attribute('y' => (accessor => 'y')); + +sub new { + my $class = shift; + $class->meta->new_object(@_); +} + +sub clear { + my $self = shift; + $self->x(0); + $self->y(0); +} + +1; + +__END__ diff --git a/benchmarks/cmop/lib/MOP/Installed/Point3D.pm b/benchmarks/cmop/lib/MOP/Installed/Point3D.pm new file mode 100644 index 0000000..e1b66f3 --- /dev/null +++ b/benchmarks/cmop/lib/MOP/Installed/Point3D.pm @@ -0,0 +1,22 @@ + +use lib reverse @INC; + +package MOP::Installed::Point3D; + +use strict; +use warnings; +use metaclass; + +use base 'MOP::Point'; + +__PACKAGE__->meta->add_attribute('z' => (accessor => 'z')); + +sub clear { + my $self = shift; + $self->SUPER::clear(); + $self->z(0); +} + +1; + +__END__ diff --git a/benchmarks/cmop/lib/MOP/Point.pm b/benchmarks/cmop/lib/MOP/Point.pm new file mode 100644 index 0000000..12160f7 --- /dev/null +++ b/benchmarks/cmop/lib/MOP/Point.pm @@ -0,0 +1,24 @@ + +package MOP::Point; + +use strict; +use warnings; +use metaclass; + +__PACKAGE__->meta->add_attribute('x' => (accessor => 'x', default => 10)); +__PACKAGE__->meta->add_attribute('y' => (accessor => 'y')); + +sub new { + my $class = shift; + $class->meta->new_object(@_); +} + +sub clear { + my $self = shift; + $self->x(0); + $self->y(0); +} + +1; + +__END__ diff --git a/benchmarks/cmop/lib/MOP/Point3D.pm b/benchmarks/cmop/lib/MOP/Point3D.pm new file mode 100644 index 0000000..0287499 --- /dev/null +++ b/benchmarks/cmop/lib/MOP/Point3D.pm @@ -0,0 +1,20 @@ + +package MOP::Point3D; + +use strict; +use warnings; +use metaclass; + +use base 'MOP::Point'; + +__PACKAGE__->meta->add_attribute('z' => (accessor => 'z')); + +sub clear { + my $self = shift; + $self->SUPER::clear(); + $self->z(0); +} + +1; + +__END__ diff --git a/benchmarks/cmop/lib/Plain/Point.pm b/benchmarks/cmop/lib/Plain/Point.pm new file mode 100644 index 0000000..3a69f56 --- /dev/null +++ b/benchmarks/cmop/lib/Plain/Point.pm @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +package Plain::Point; + +use strict; +use warnings; + +sub new { + my ( $class, %params ) = @_; + + return bless { + x => $params{x} || 10, + y => $params{y}, + }, $class; +} + +sub x { + my ( $self, @args ) = @_; + + if ( @args ) { + $self->{x} = $args[0]; + } + + return $self->{x}; +} + +sub y { + my ( $self, @args ) = @_; + + if ( @args ) { + $self->{y} = $args[0]; + } + + return $self->{y}; +} + +sub clear { + my $self = shift; + @{$self}{qw/x y/} = (0, 0); +} + +__PACKAGE__; + +__END__ diff --git a/benchmarks/cmop/lib/Plain/Point3D.pm b/benchmarks/cmop/lib/Plain/Point3D.pm new file mode 100644 index 0000000..87a460e --- /dev/null +++ b/benchmarks/cmop/lib/Plain/Point3D.pm @@ -0,0 +1,35 @@ +#!/usr/bin/perl + +package Plain::Point3D; + +use strict; +use warnings; + +use base 'Plain::Point'; + +sub new { + my ( $class, %params ) = @_; + my $self = $class->SUPER::new( %params ); + $self->{z} = $params{z}; + return $self; +} + +sub z { + my ( $self, @args ) = @_; + + if ( @args ) { + $self->{z} = $args[0]; + } + + return $self->{z}; +} + +sub clear { + my $self = shift; + $self->SUPER::clear(); + $self->{z} = 0; +} + +__PACKAGE__; + +__END__ diff --git a/benchmarks/cmop/loading-benchmark.pl b/benchmarks/cmop/loading-benchmark.pl new file mode 100755 index 0000000..612ae63 --- /dev/null +++ b/benchmarks/cmop/loading-benchmark.pl @@ -0,0 +1,27 @@ +#!perl -w +use strict; +use Benchmark qw(:all); + +my ( $count, $module ) = @ARGV; +$count ||= 10; +$module ||= 'Moose'; + +my @blib + = qw(-Iblib/lib -Iblib/arch -I../Moose/blib/lib -I../Moose/blib/arch -I../Moose/lib); + +$| = 1; # autoflush + +print 'Installed: '; +system $^X, '-le', 'require Moose; print $INC{q{Moose.pm}}'; + +print 'Blead: '; +system $^X, @blib, '-le', 'require Moose; print $INC{q{Moose.pm}}'; + +cmpthese timethese $count => { + released => sub { + system( $^X, '-e', "require $module" ) == 0 or die; + }, + blead => sub { + system( $^X, @blib, '-e', "require $module" ) == 0 or die; + }, +}; diff --git a/benchmarks/cmop/profile.pl b/benchmarks/cmop/profile.pl new file mode 100755 index 0000000..4ea5b01 --- /dev/null +++ b/benchmarks/cmop/profile.pl @@ -0,0 +1,25 @@ +#!perl -w +# Usage: perl bench/profile.pl (no other options including -Mblib are reqired) + +use strict; + +my $script = 'bench/foo.pl'; + +my $branch = do { + open my $in, '.git/HEAD' or die "Cannot open .git/HEAD: $!"; + my $s = scalar <$in>; + chomp $s; + $s =~ s{^ref: \s+ refs/heads/}{}xms; + $s =~ s{/}{_}xmsg; + $s; +}; + +print "Profiling $branch ...\n"; + +my @cmd = ( $^X, '-Iblib/lib', '-Iblib/arch', $script ); +print "> @cmd\n"; +system(@cmd) == 0 or die "Cannot profile"; + +@cmd = ( $^X, '-S', 'nytprofhtml', '--out', "nytprof-$branch" ); +print "> @cmd\n"; +system(@cmd) == 0 or die "Cannot profile"; diff --git a/benchmarks/cmop/run_yml.pl b/benchmarks/cmop/run_yml.pl new file mode 100644 index 0000000..341b640 --- /dev/null +++ b/benchmarks/cmop/run_yml.pl @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; + +use YAML::Syck; +use Bench::Run; + +my $data = LoadFile( shift || "$FindBin::Bin/all.yml" ); + +foreach my $bench ( @$data ) { + print "== ", delete $bench->{name}, " ==\n\n"; + Bench::Run->new( %$bench )->run; + print "\n\n"; +} diff --git a/benchmarks/immutable.pl b/benchmarks/immutable.pl new file mode 100644 index 0000000..0263404 --- /dev/null +++ b/benchmarks/immutable.pl @@ -0,0 +1,99 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Benchmark qw[cmpthese]; + +use Moose::Util::TypeConstraints; + +{ + package Foo; + use Moose; + Foo->meta->make_immutable(debug => 0); +} + +coerce 'Foo' + => from 'ArrayRef' + => via { Foo->new(@{$_}) }; + +{ + package Foo::Normal; + use Moose; + + has 'default' => (is => 'rw', default => 10); + has 'default_sub' => (is => 'rw', default => sub { [] }); + has 'lazy' => (is => 'rw', default => 10, lazy => 1); + has 'required' => (is => 'rw', required => 1); + has 'weak_ref' => (is => 'rw', weak_ref => 1); + has 'type_constraint' => (is => 'rw', isa => 'Foo'); + has 'coercion' => (is => 'rw', isa => 'Foo', coerce => 1); + + package Bar::Normal; + use Moose; + + extends 'Foo::Normal'; + + has 'default_w_type_constraint' => ( + is => 'rw', + isa => 'Int', + default => 10, + ); +} + +{ + package Foo::Immutable; + use Moose; + + has 'default' => (is => 'rw', default => 10); + has 'default_sub' => (is => 'rw', default => sub { [] }); + has 'lazy' => (is => 'rw', default => 10, lazy => 1); + has 'required' => (is => 'rw', required => 1); + has 'weak_ref' => (is => 'rw', weak_ref => 1); + has 'type_constraint' => (is => 'rw', isa => 'Foo'); + has 'coercion' => (is => 'rw', isa => 'Foo', coerce => 1); + + #sub BUILD { + # # ... + #} + + Foo::Immutable->meta->make_immutable(debug => 0); + + package Bar::Immutable; + use Moose; + + extends 'Foo::Immutable'; + + has 'default_w_type_constraint' => ( + is => 'rw', + isa => 'Int', + default => 10, + ); + + Bar::Immutable->meta->make_immutable(debug => 0); +} + +#__END__ + +my $foo = Foo->new; + +cmpthese(10_000, + { + 'normal' => sub { + Foo::Normal->new( + required => 'BAR', + type_constraint => $foo, + coercion => [], + weak_ref => {}, + ); + }, + 'immutable' => sub { + Foo::Immutable->new( + required => 'BAR', + type_constraint => $foo, + coercion => [], + weak_ref => {}, + ); + }, + } +);
\ No newline at end of file diff --git a/benchmarks/lotsa-classes.pl b/benchmarks/lotsa-classes.pl new file mode 100644 index 0000000..c21decd --- /dev/null +++ b/benchmarks/lotsa-classes.pl @@ -0,0 +1,78 @@ +#!/usr/bin/env perl + +use warnings FATAL => 'all'; +use strict; +use File::Temp; +use Path::Class; + +my $number_of_classes = shift || 1500; +my $number_of_attributes = shift || 20; +my $t = shift || File::Temp->newdir; +my $tmp = dir($t); +$tmp->rmtree; +$tmp->mkpath; +(-d $tmp) or die "not a dir: $tmp"; +#print "$tmp\n"; + +my %class_writer = ( + 'Moose' => sub { + my $name = shift; + my $attrs = join '', map { "has '$_' => ( is => 'ro', isa => 'Str' );\n" } @_; + return qq{package $name;\nuse Moose;\n$attrs\n1;\n__END__\n}; + }, + 'MooseImmutable' => sub { + my $name = shift; + my $attrs = join '', map { "has '$_' => ( is => 'ro', isa => 'Str' );\n" } @_; + return qq{package $name;\nuse Moose;\n$attrs\n__PACKAGE__->meta->make_immutable;\n1;\n__END__\n}; + }, + 'Moo' => sub { + my $name = shift; + my $attrs = join'', map { "has '$_' => ( is => 'ro', isa => 'Str' );\n" } @_; + return qq{package $name;\nuse Moo;\n$attrs\n1;\n__END__\n}; + }, + 'Mo' => sub { + my $name = shift; + my $attrs = join'', map { "has '$_' => ( is => 'ro', isa => 'Str' );\n" } @_; + return qq{package $name;\nuse Mo;\n$attrs\n1;\n__END__\n}; + }, + 'Mouse' => sub { + my $name = shift; + my $attrs = join'', map { "has '$_' => ( is => 'ro', isa => 'Str' );\n" } @_; + return qq{package $name;\nuse Mouse;\n$attrs\n1;\n__END__\n}; + }, + 'plain-package' => sub { + my $name = shift; + my $attrs = join'', map { "sub $_ {}\n" } @_; + return qq{package $name;\n$attrs\n1;\n__END__\n}; + }, +); + +my $class_prefix = 'TmpClassThingy'; +my %lib_map; +my @attribute_names = map { 'a' . $_ } 1 .. $number_of_attributes; +for my $module (sort keys %class_writer) { + my $lib = $tmp->subdir($module . '-lib'); + $lib->mkpath; + my $all_fh = $lib->file('All.pm')->openw; + for my $n (1 .. $number_of_classes) { + my $class_name = $class_prefix . $n; + my $fh = $lib->file($class_name . '.pm')->openw; + $fh->say($class_writer{$module}->($class_name, @attribute_names)) or die; + $fh->close or die; + $all_fh->say("use $class_name;") or die; + } + $all_fh->say('1;') or die; + $all_fh->close or die; + $lib_map{$module} = $lib; +} + +#$DB::single = 1; +for my $module (sort keys %lib_map) { + my $lib = $lib_map{$module}; + print "$module\n"; + my $cmd = "time -p $^X -I$lib -MAll -e '1'"; + `$cmd > /dev/null 2>&1`; # to cache +# print "$cmd\n"; + system($cmd); + print "\n"; +} diff --git a/benchmarks/method_modifiers.pl b/benchmarks/method_modifiers.pl new file mode 100755 index 0000000..ac860a9 --- /dev/null +++ b/benchmarks/method_modifiers.pl @@ -0,0 +1,116 @@ +#!perl + +### MODULES + +{ + package PlainParent; + sub new { bless {} => shift } + sub method { "P" } +} +{ + package MooseParent; + use Moose; + sub method { "P" } +} + +{ + package CMMChild::Before; + use Class::Method::Modifiers; + use base 'PlainParent'; + + before method => sub { "B" }; +} +{ + package MooseBefore; + use Moose; + extends 'MooseParent'; + + before method => sub { "B" }; +} + +{ + package CMMChild::Around; + use Class::Method::Modifiers; + use base 'PlainParent'; + + around method => sub { shift->() . "A" }; +} +{ + package MooseAround; + use Moose; + extends 'MooseParent'; + + around method => sub { shift->() . "A" }; +} + +{ + package CMMChild::AllThree; + use Class::Method::Modifiers; + use base 'PlainParent'; + + before method => sub { "B" }; + around method => sub { shift->() . "A" }; + after method => sub { "Z" }; +} +{ + package MooseAllThree; + use Moose; + extends 'MooseParent'; + + before method => sub { "B" }; + around method => sub { shift->() . "A" }; + after method => sub { "Z" }; +} +{ + package CMM::Install; + use Class::Method::Modifiers; + use base 'PlainParent'; +} +{ + package Moose::Install; + use Moose; + extends 'MooseParent'; +} + +use Benchmark qw(cmpthese); +use Benchmark ':hireswallclock'; + +my $rounds = -5; + +my $cmm_before = CMMChild::Before->new(); +my $cmm_around = CMMChild::Around->new(); +my $cmm_allthree = CMMChild::AllThree->new(); + +my $moose_before = MooseBefore->new(); +my $moose_around = MooseAround->new(); +my $moose_allthree = MooseAllThree->new(); + +print "\nBEFORE\n"; +cmpthese($rounds, { + Moose => sub { $moose_before->method() }, + ClassMethodModifiers => sub { $cmm_before->method() }, +}, 'noc'); + +print "\nAROUND\n"; +cmpthese($rounds, { + Moose => sub { $moose_around->method() }, + ClassMethodModifiers => sub { $cmm_around->method() }, +}, 'noc'); + +print "\nALL THREE\n"; +cmpthese($rounds, { + Moose => sub { $moose_allthree->method() }, + ClassMethodModifiers => sub { $cmm_allthree->method() }, +}, 'noc'); + +print "\nINSTALL AROUND\n"; +cmpthese($rounds, { + Moose => sub { + package Moose::Install; + Moose::Install::around(method => sub {}); + }, + ClassMethodModifiers => sub { + package CMM::Install; + CMM::Install::around(method => sub {}); + }, +}, 'noc'); diff --git a/benchmarks/moose_bench.pl b/benchmarks/moose_bench.pl new file mode 100755 index 0000000..b8dc426 --- /dev/null +++ b/benchmarks/moose_bench.pl @@ -0,0 +1,152 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Time::HiRes 'time'; +use List::Util 'sum'; +use IPC::System::Simple 'system'; +use autodie; +use Parse::BACKPAN::Packages; +use LWP::Simple; +use Archive::Tar; +use Path::Tiny; + +my $backpan = Parse::BACKPAN::Packages->new; +my @cmops = $backpan->distributions('Class-MOP'); +my @mooses = $backpan->distributions('Moose'); + +my $cmop_version = 0; +my $cmop_dir; + +my $base = "http://backpan.cpan.org/"; + +my %time; +my %mem; + +open my $output, ">", "moose_bench.txt"; + +for my $moose (@mooses) { + my $moose_dir = build($moose); + + # Find the CMOP dependency + my $makefile = path("$moose_dir/Makefile.PL")->slurp_utf8; + my ($cmop_dep) = $makefile =~ /Class::MOP.*?([0-9._]+)/ + or die "Unable to find Class::MOP version dependency in $moose_dir/Makefile.PL"; + + # typo? + $cmop_dep = '0.64_07' if $cmop_dep eq '0.6407'; + + # nonexistent dev releases? + $cmop_dep = '0.79' if $cmop_dep eq '0.78_02'; + $cmop_dep = '0.83' if $cmop_dep eq '0.82_01'; + + bump_cmop($cmop_dep, $moose); + + warn "Building $moose_dir"; + eval { + system("(cd '$moose_dir' && '$^X' '-I$cmop_dir/lib' Makefile.PL && make && sudo make install) >/dev/null"); + + my @times; + for (1 .. 5) { + my $start = time; + system( + $^X, + "-I$moose_dir/lib", + "-I$cmop_dir/lib", + '-e', 'package Class; use Moose;', + ); + push @times, time - $start; + } + + $time{$moose->version} = sum(@times) / @times; + $mem{$moose->version} = qx[$^X -I$moose_dir/lib -I$cmop_dir/lib -MGTop -e 'my (\$gtop, \$before); BEGIN { \$gtop = GTop->new; \$before = \$gtop->proc_mem(\$\$)->size; } package Class; use Moose; print \$gtop->proc_mem(\$\$)->size - \$before']; + my $line = sprintf "%7s: %0.4f (%s), %d bytes\n", + $moose->version, + $time{$moose->version}, + join(', ', map { sprintf "%0.4f", $_ } @times), + $mem{$moose->version}; + print $output $line; + }; + warn $@ if $@; +} + +require Chart::Clicker; +require Chart::Clicker::Data::Series; +require Chart::Clicker::Data::DataSet; +my @versions = sort keys %time; +my @startups = map { $time{$_} } @versions; +my @memories = map { int($mem{$_} / 1024) } @versions; +my @keys = (0..$#versions); +my $cc = Chart::Clicker->new(width => 900, height => 400); +my $sutime = Chart::Clicker::Data::Series->new( + values => \@startups, + keys => \@keys, + name => 'Startup Time', +); +my $def = $cc->get_context('default'); +$def->domain_axis->tick_values(\@keys); +$def->domain_axis->tick_labels(\@versions); +$def->domain_axis->tick_label_angle(1.57); +$def->domain_axis->tick_font->size(8); +$def->range_axis->fudge_amount('0.05'); + +my $context = Chart::Clicker::Context->new(name => 'memory'); +$context->range_axis->tick_values([qw(1024 2048 3072 4096 5120)]); +$context->range_axis->format('%d'); +$context->domain_axis->hidden(1); +$context->range_axis->fudge_amount('0.05'); +$cc->add_to_contexts($context); + +my $musage = Chart::Clicker::Data::Series->new( + values => \@memories, + keys => \@keys, + name => 'Memory Usage (kb)' +); + +my $ds1 = Chart::Clicker::Data::DataSet->new(series => [ $sutime ]); +my $ds2 = Chart::Clicker::Data::DataSet->new(series => [ $musage ]); +$ds2->context('memory'); + +$cc->add_to_datasets($ds1); +$cc->add_to_datasets($ds2); +$cc->write_output('moose_bench.png'); + +sub bump_cmop { + my $expected = shift; + my $moose = shift; + + return $cmop_dir if $cmop_version eq $expected; + + my @orig_cmops = @cmops; + shift @cmops until !@cmops || $cmops[0]->version eq $expected; + + die "Ran out of cmops, wanted $expected for " + . $moose->distvname + . " (had " . join(', ', map { $_->version } @orig_cmops) . ")" + if !@cmops; + + $cmop_version = $cmops[0]->version; + $cmop_dir = build($cmops[0]); + + warn "Building $cmop_dir"; + system("(cd '$cmop_dir' && '$^X' Makefile.PL && make && sudo make install) >/dev/null"); + + return $cmop_dir; +} + +sub build { + my $dist = shift; + my $distvname = $dist->distvname; + return $distvname if -d $distvname; + + warn "Downloading $distvname"; + my $tarball = get($base . $dist->prefix); + open my $handle, '<', \$tarball; + + my $tar = Archive::Tar->new; + $tar->read($handle); + $tar->extract; + + my ($arbitrary_file) = $tar->list_files; + (my $directory = $arbitrary_file) =~ s{/.*}{}; + return $directory; +} diff --git a/benchmarks/simple_class.pl b/benchmarks/simple_class.pl new file mode 100644 index 0000000..f0061f1 --- /dev/null +++ b/benchmarks/simple_class.pl @@ -0,0 +1,31 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Benchmark::Forking qw[cmpthese]; + +=pod + +This compares the burden of a basic Moose +class to a basic Class::MOP class. + +It is worth noting that the basic Moose +class will also create a type constraint +as well as export many subs, so this comparison +is really not fair :) + +=cut + +cmpthese(5_000, + { + 'w/out_moose' => sub { + eval 'package Bar; use metaclass;'; + }, + 'w_moose' => sub { + eval 'package Baz; use Moose;'; + }, + } +); + +1;
\ No newline at end of file diff --git a/benchmarks/simple_compile.pl b/benchmarks/simple_compile.pl new file mode 100644 index 0000000..4b5b4a8 --- /dev/null +++ b/benchmarks/simple_compile.pl @@ -0,0 +1,34 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Benchmark::Forking qw[cmpthese]; + +=pod + +This compare the overhead of Class::MOP +to the overhead of Moose. + +The goal here is to see how much more +startup cost Moose adds to Class::MOP. + +NOTE: +This benchmark may not be all that +relevant really, but it's helpful to +see maybe. + +=cut + +cmpthese(5_000, + { + 'w/out_moose' => sub { + eval 'use Class::MOP;'; + }, + 'w_moose' => sub { + eval 'use Moose;'; + }, + } +); + +1;
\ No newline at end of file diff --git a/benchmarks/simple_constructor.pl b/benchmarks/simple_constructor.pl new file mode 100644 index 0000000..def63ed --- /dev/null +++ b/benchmarks/simple_constructor.pl @@ -0,0 +1,26 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +my $num_iterations = shift || 100; + +{ + package Foo; + use Moose; + + has 'default' => (is => 'rw', default => 10); + has 'default_sub' => (is => 'rw', default => sub { [] }); + has 'lazy' => (is => 'rw', default => 10, lazy => 1); + has 'required' => (is => 'rw', required => 1); + has 'weak_ref' => (is => 'rw', weak_ref => 1); + has 'type_constraint' => (is => 'rw', isa => 'ArrayRef'); +} + +foreach (0 .. $num_iterations) { + my $foo = Foo->new( + required => 'BAR', + type_constraint => [], + weak_ref => {}, + ); +}
\ No newline at end of file diff --git a/benchmarks/type_constraints.pl b/benchmarks/type_constraints.pl new file mode 100644 index 0000000..e9b29f8 --- /dev/null +++ b/benchmarks/type_constraints.pl @@ -0,0 +1,53 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Benchmark qw[cmpthese]; + +=pod + +This benchmark compares the overhead of a +auto-created type constraint vs. none at +all vs. a custom-created type. + +=cut + +{ + package Foo; + use Moose; + use Moose::Util::TypeConstraints; + + has 'baz' => (is => 'rw'); + has 'bar' => (is => 'rw', isa => 'Foo'); +} + +{ + package Bar; + + sub new { bless {} => __PACKAGE__ } + sub bar { + my $self = shift; + $self->{bar} = shift if @_; + $self->{bar}; + } +} + +my $foo = Foo->new; +my $bar = Bar->new; + +cmpthese(200_000, + { + 'hand coded' => sub { + $bar->bar($bar); + }, + 'w/out_constraint' => sub { + $foo->baz($foo); + }, + 'w_constraint' => sub { + $foo->bar($foo); + }, + } +); + +1;
\ No newline at end of file diff --git a/benchmarks/type_constraints2.pl b/benchmarks/type_constraints2.pl new file mode 100644 index 0000000..7c97b99 --- /dev/null +++ b/benchmarks/type_constraints2.pl @@ -0,0 +1,153 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Benchmark qw[timethese]; + +=pod + +This benchmark is designed to measure how long things with type constraints +take (constructors, accessors). It was created to measure the impact of +inlining type constraints. + +=cut + +{ + package Thing; + + use Moose; + + has int => ( + is => 'rw', + isa => 'Int', + ); + + has str => ( + is => 'rw', + isa => 'Str', + ); + + has fh => ( + is => 'rw', + isa => 'FileHandle', + ); + + has object => ( + is => 'rw', + isa => 'Object', + ); + + has a_int => ( + is => 'rw', + isa => 'ArrayRef[Int]', + ); + + has a_str => ( + is => 'rw', + isa => 'ArrayRef[Str]', + ); + + has a_fh => ( + is => 'rw', + isa => 'ArrayRef[FileHandle]', + ); + + has a_object => ( + is => 'rw', + isa => 'ArrayRef[Object]', + ); + + has h_int => ( + is => 'rw', + isa => 'HashRef[Int]', + ); + + has h_str => ( + is => 'rw', + isa => 'HashRef[Str]', + ); + + has h_fh => ( + is => 'rw', + isa => 'HashRef[FileHandle]', + ); + + has h_object => ( + is => 'rw', + isa => 'HashRef[Object]', + ); + + __PACKAGE__->meta->make_immutable; +} + +{ + package Simple; + use Moose; + + has str => ( + is => 'rw', + isa => 'Str', + ); + + __PACKAGE__->meta->make_immutable; +} + +my @ints = 1 .. 10; +my @strs = 'a' .. 'j'; +my @fhs = map { my $fh; open $fh, '<', $0 or die; $fh; } 1 .. 10; +my @objects = map { Thing->new } 1 .. 10; + +my %ints = map { $_ => $_ } @ints; +my %strs = map { $_ => $_ } @ints; +my %fhs = map { $_ => $_ } @fhs; +my %objects = map { $_ => $_ } @objects; + +my $thing = Thing->new; +my $simple = Simple->new; + +timethese( + 1_000_000, { + constructor_simple => sub { + Simple->new( str => $strs[0] ); + }, + accessors_simple => sub { + $simple->str( $strs[0] ); + }, + } +); + +timethese( + 20_000, { + constructor_all => sub { + Thing->new( + int => $ints[0], + str => $strs[0], + fh => $fhs[0], + object => $objects[0], + a_int => \@ints, + a_str => \@strs, + a_fh => \@fhs, + a_object => \@objects, + h_int => \%ints, + h_str => \%strs, + h_fh => \%fhs, + h_object => \%objects, + ); + }, + accessors_all => sub { + $thing->int( $ints[0] ); + $thing->str( $strs[0] ); + $thing->fh( $fhs[0] ); + $thing->object( $objects[0] ); + $thing->a_int( \@ints ); + $thing->a_str( \@strs ); + $thing->a_fh( \@fhs ); + $thing->a_object( \@objects ); + $thing->h_int( \%ints ); + $thing->h_str( \%strs ); + $thing->h_fh( \%fhs ); + $thing->h_object( \%objects ); + }, + } +); |