Add benchmark scripts (bench/xs/*.pl)

diff --git a/bench/xs/accessor.pl b/bench/xs/accessor.pl
new file mode 100755 (executable)
index 0000000..9d14c33
--- /dev/null
+++ b/bench/xs/accessor.pl
@@ -0,0 +1,183 @@
+#!perl
+# with "Class-MOP/topic/unified-method-generation-w-xs" and" Moose/topic/xs-accessor"
+use strict;
+use Benchmark qw(:all);
+use Config; printf "Perl/%vd in $Config{archname}\n\n", $^V;
+use warnings;
+no warnings 'once';
+
+my $cxsa_is_loaded = eval q{
+    package CXSA;
+    use Class::XSAccessor
+        constructor => 'new',
+        accessors   => {
+            simple => 'simple',
+        },
+    ;
+    1;
+};
+my $mouse_is_loaded = eval q{
+       package MousePlain;
+       use Mouse;
+       has simple => (
+               is => 'rw',
+       );
+       __PACKAGE__->meta->make_immutable;
+};
+{
+       package My::Meta::Instance;
+       use parent qw(Moose::Meta::Instance);
+       sub can_xs{ 0 }
+
+       package MoosePlain;
+       use Moose;
+       __PACKAGE__->meta->{instance_metaclass} = 'My::Meta::Instance';
+       has simple => (
+               is => 'rw',
+       );
+       has with_lazy => (
+           is      => 'rw',
+           lazy    => 1,
+           default => 42,
+       );
+       has with_tc => (
+           is  => 'rw',
+           isa => 'Num',
+       );
+       __PACKAGE__->meta->make_immutable;
+}
+{
+       package MooseXS;
+       use Moose;
+       has simple => (
+               is => 'rw',
+       );
+       has with_lazy => (
+           is      => 'rw',
+           lazy    => 1,
+           default => 42,
+       );
+       has with_tc => (
+           is  => 'rw',
+           isa => 'Num',
+       );
+       __PACKAGE__->meta->make_immutable;
+}
+
+use B qw(svref_2object);
+
+print "Moose/$Moose::VERSION (Class::MOP/$Class::MOP::VERSION)\n";
+print "Mouse/$Mouse::VERSION\n" if $mouse_is_loaded;
+print "Class::XSAccessor/$Class::XSAccessor::VERSION\n" if $cxsa_is_loaded;
+
+sub method_type{
+       my($class) = @_;
+       return svref_2object($class->can('simple'))->XSUB    ? 'XS'
+            : $class->meta->get_method('simple')->is_inline ? 'Inline'
+                                                            : 'Basic';
+}
+
+print 'MoosePlain: ', method_type('MoosePlain'), "\n";
+print 'MooseXS:    ', method_type('MooseXS'),    "\n";
+
+my $mi = MoosePlain->new();
+my $mx = MooseXS->new();
+my $mu;
+$mu = MousePlain->new if $mouse_is_loaded;
+my $cx;
+$cx = CXSA->new       if $cxsa_is_loaded;
+
+
+print "\nGETTING for simple attributes\n";
+cmpthese -1 => {
+       'Moose/Plain' => sub{
+               my $x;
+               $x = $mi->simple();
+               $x = $mi->simple();
+       },
+       'Moose/XS' => sub{
+               my $x;
+               $x = $mx->simple();
+               $x = $mx->simple();
+       },
+       $mouse_is_loaded ? (
+       'Mouse' => sub{
+               my $x;
+               $x = $mu->simple();
+               $x = $mu->simple();
+       },
+       ) : (),
+       $cxsa_is_loaded ? (
+       'C::XSAccessor' => sub{
+               my $x;
+               $x = $cx->simple();
+               $x = $cx->simple();
+       },
+       ) : (),
+};
+
+print "\nSETTING for simple attributes\n";
+cmpthese -1 => {
+       'Moose/Plain' => sub{
+               $mi->simple(10);
+               $mi->simple(10);
+       },
+       'Moose/XS' => sub{
+               $mx->simple(10);
+               $mx->simple(10);
+       },
+
+       $mouse_is_loaded ? (
+       'Mouse' => sub{
+               $mu->simple(10);
+               $mu->simple(10);
+       },
+       ) : (),
+       $cxsa_is_loaded ? (
+       'C::XSAccessor' => sub{
+               $cx->simple(10);
+               $cx->simple(10);
+       },
+       ) : (),
+
+};
+
+print "\nGETTING for lazy attributes (except for C::XSAccessor)\n";
+cmpthese -1 => {
+       'Moose/Plain' => sub{
+               my $x;
+               $x = $mi->with_lazy();
+               $x = $mi->with_lazy();
+       },
+       'Moose/XS' => sub{
+               my $x;
+               $x = $mx->with_lazy();
+               $x = $mx->with_lazy();
+       },
+       $cxsa_is_loaded ? (
+       'C::XSAccessor' => sub{
+               my $x;
+               $x = $cx->simple();
+               $x = $cx->simple();
+       },
+       ) : (),
+};
+
+print "\nSETTING for attributes with type constraints (except for C::XSAccessor)\n";
+cmpthese -1 => {
+       'Moose/Plain' => sub{
+               $mi->with_tc(10);
+               $mi->with_tc(10);
+       },
+       'Moose/XS' => sub{
+               $mx->with_tc(10);
+               $mx->with_tc(10);
+       },
+       $cxsa_is_loaded ? (
+       'C::XSAccessor' => sub{
+               $cx->simple(10);
+               $cx->simple(10);
+       },
+       ) : (),
+};
+

diff --git a/bench/xs/class-definition.pl b/bench/xs/class-definition.pl
new file mode 100755 (executable)
index 0000000..a3a9314
--- /dev/null
+++ b/bench/xs/class-definition.pl
@@ -0,0 +1,87 @@
+#!perl
+# with "Class-MOP/topic/unified-method-generation-w-xs" and" Moose/topic/xs-accessor"
+use strict;
+use Benchmark qw(:all);
+use Config; printf "Perl/%vd in $Config{archname}\n\n", $^V;
+use warnings;
+no warnings 'once';
+
+my $mouse_is_loaded = eval { require Mouse };
+
+{
+       package My::Meta::Instance;
+       use parent qw(Moose::Meta::Instance);
+       sub can_xs{ 0 }
+}
+
+print "Class definition\n";
+my $i = 0;
+my $j = 0;
+my $k = 0;
+
+cmpthese 40 => {
+       'Moose/Plain' => sub{
+               $i++;
+               my $src = '';
+               for my $c(qw(A B C D E F G H I J)){
+                       $src .= qq{{
+                               package MI_$c$i;
+                               use Moose;
+                               my \$meta = __PACKAGE__->meta;
+                               \$meta->{instance_metaclass} = 'My::Meta::Instance';
+
+                               has attr1 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr2 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr3 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr4 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr5 => (is => 'rw', isa => 'Int', lazy_build => 1);
+
+                               \$meta->make_immutable();
+                       }};
+               }
+               eval $src or die $@;
+       },
+       'Moose/XS' => sub{
+               $j++;
+               my $src = '';
+               for my $c(qw(A B C D E F G H I J)){
+                       $src .= qq{{
+                               package MX_$c$j;
+                               use Moose;
+                               my \$meta = __PACKAGE__->meta;
+                               #\$meta->{instance_metaclass} = 'My::Meta::Instance';
+
+                               has attr1 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr2 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr3 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr4 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr5 => (is => 'rw', isa => 'Int', lazy_build => 1);
+
+                               \$meta->make_immutable();
+                       }};
+               }
+               eval $src or die $@;
+       },
+       $mouse_is_loaded ? (
+       'Mouse' => sub{
+               $k++;
+               my $src = '';
+               for my $c(qw(A B C D E F G H I J)){
+                       $src .= qq{{
+                               package MU_$c$k;
+                               use Mouse;
+                               my \$meta = __PACKAGE__->meta;
+                               \$meta->{instance_metaclass} = 'My::Meta::Instance';
+
+                               has attr1 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr2 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr3 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr4 => (is => 'rw', isa => 'Int', lazy_build => 1);
+                               has attr5 => (is => 'rw', isa => 'Int', lazy_build => 1);
+
+                               \$meta->make_immutable();
+                       }};
+               }
+               eval $src or die $@;
+       }) : (),
+};

diff --git a/bench/xs/constructor.pl b/bench/xs/constructor.pl
new file mode 100755 (executable)
index 0000000..65c566c
--- /dev/null
+++ b/bench/xs/constructor.pl
@@ -0,0 +1,77 @@
+#!perl -w
+use strict;
+use Config; printf "Perl/%vd in $Config{archname}\n\n", $^V;
+use Benchmark qw(:all);
+
+{
+       package MOP_Plain;
+       use metaclass;
+
+    __PACKAGE__->meta->add_attribute('foo' => (
+        reader  => 'foo',
+        default => 'FOO',
+    ));
+    __PACKAGE__->meta->add_attribute('bar' => (
+        reader  => 'bar',
+        default => 'BAR',
+    ));
+    __PACKAGE__->meta->add_attribute('baz' => (
+        reader  => 'baz',
+        default => 'BAZ',
+    ));
+    __PACKAGE__->meta->add_attribute('bax' => (
+        reader  => 'bax',
+        default => 'BAX',
+    ));
+
+       no warnings 'redefine';
+       local *Class::MOP::Instance::can_xs = sub{ 0 };
+       __PACKAGE__->meta->make_immutable;
+}
+{
+       package MOP_XS;
+       use metaclass;
+
+    __PACKAGE__->meta->add_attribute('foo' => (
+        reader  => 'foo',
+        default => 'FOO',
+    ));
+    __PACKAGE__->meta->add_attribute('bar' => (
+        reader  => 'bar',
+        default => 'BAR',
+    ));
+    __PACKAGE__->meta->add_attribute('baz' => (
+        reader  => 'baz',
+        default => 'BAZ',
+    ));
+    __PACKAGE__->meta->add_attribute('bax' => (
+        reader  => 'bax',
+        default => 'BAX',
+    ));
+
+       __PACKAGE__->meta->make_immutable;
+}
+
+# prepre caches
+MOP_Plain->new;
+MOP_XS->new;
+
+print "MOP constructor (default)\n";
+cmpthese -1 => {
+       'Plain' => sub{
+               my $x = MOP_Plain->new();
+       },
+       'XS'    => sub{
+               my $x = MOP_XS->new();
+       },
+};
+
+print "MOP constructor (non-default)\n";
+cmpthese -1 => {
+       'Plain' => sub{
+               my $x = MOP_Plain->new(foo => 'FOO', bar => 'BAR', baz => 'BAZ');
+       },
+       'XS'    => sub{
+               my $x = MOP_XS->new(foo => 'FOO', bar => 'BAR', baz => 'BAZ');
+       },
+};

diff --git a/bench/xs/loading.pl b/bench/xs/loading.pl
new file mode 100755 (executable)
index 0000000..3475e58
--- /dev/null
+++ b/bench/xs/loading.pl
@@ -0,0 +1,35 @@
+#!perl -w
+use strict;
+use warnings;
+
+use Benchmark qw(:all);
+use Config; printf "Perl/%vd on $Config{archname}\n\n", $^V;
+
+my $n      = shift || 20;
+
+for my $module (qw(Moose KiokuDB HTTP::Engine Catalyst)){
+    print "For $module\n";
+    my $plain = <<"END";
+    sub Moose::Meta::Instance::can_xs{ 0 }
+    require Moose; # prefer Moose
+    require $module;
+END
+
+    my $xs = <<"END";
+    sub Moose::Meta::Instance::foo{ 0 } # dummy
+    require Moose; # prefer Moose
+    require $module;
+END
+
+    system(qq{$^X -e '$plain'}) == 0 or die $?;
+    system(qq{$^X -e '$xs'})    == 0 or die $?;
+
+    cmpthese  $n => {
+        'Moose/Plain' => sub{
+            system(qq{$^X -we '$plain'}) == 0 or die $!;
+        },
+        'Moose/XS' =>sub{
+            system(qq{$^X -we '$xs'}) == 0 or die $!;
+        },
+    };
+}