benchmarks/class_type.pl

   1 #!perl
   2 use strict;
   3 use warnings;
   4 use Benchmark qw/cmpthese/;
   5
   6 {
   7     package Foo;
   8     sub new{ bless {}, shift }
   9 }
  10
  11 eval q{
  12     package C::XSAOne;
  13     use Class::XSAccessor
  14         constructor => 'new',
  15         accessors   => { n => 'n' },
  16     ;
  17     1;
  18 };
  19
  20 for my $klass (qw/Moose Mouse/) {
  21     eval qq{
  22         package ${klass}One;
  23         use $klass;
  24
  25         has n => (
  26             is  => 'rw',
  27             isa => 'Foo',
  28         );
  29         no $klass;
  30         __PACKAGE__->meta->make_immutable;
  31     };
  32     die $@ if $@;
  33 }
  34
  35 print "Class::MOP: $Class::MOP::VERSION\n";
  36 print "Moose:      $Moose::VERSION\n";
  37 print "Mouse:      $Mouse::VERSION\n";
  38 print "---- new\n";
  39
  40 my $foo = Foo->new();
  41
  42 my @classes = qw(Moose Mouse);
  43 if(C::XSAOne->can('new')){
  44     push @classes, 'C::XSA';
  45 }
  46
  47 cmpthese(
  48     -1 => {
  49         map { my $x = $_; $_ => sub { $x->new(n => $foo) } }
  50         map { "${_}One" } @classes
  51     }
  52 );
  53
  54 print "---- new,set\n";
  55 cmpthese(
  56     -1 => {
  57         map { my $y = $_; $_ => sub { $y->new(n => $foo)->n($foo) } }
  58         map { "${_}One" } @classes
  59     }
  60 );
  61
  62 print "---- set\n";
  63 my %c = map { $_ => "${_}One"->new(n => $foo) } @classes;
  64 cmpthese(
  65     -1 => {
  66         map { my $y = $_; $_ => sub { $c{$y}->n($foo) } } @classes
  67     }
  68 );