git.maemo.org Git - pkg-perl/blob - deb-src/libclass-accessor-perl/libclass-accessor-perl-0.31/examples/benchmark

   1 #!/usr/bin/perl -w
   2
   3 package Bench::Base;
   4
   5 sub new {
   6     my($class) = shift;
   7     bless { test => 23 }, $class;
   8 }
   9
  10 package Bench::Direct;
  11 use base qw(Bench::Base);
  12
  13 package Bench::ByHand;
  14 use base qw(Bench::Base);
  15
  16 sub test {
  17     my($self) = shift;
  18     if( @_ ) {
  19         $self->{test} = (@_ == 1 ? $_[0] : [@_]);
  20     }
  21     return $self->{test};
  22 }
  23
  24 package Bench::Class::Accessor;
  25 use base qw(Class::Accessor);
  26 __PACKAGE__->mk_accessors(qw(test));
  27
  28
  29 package Bench::Class::Accessor::Fast;
  30 use base qw(Class::Accessor::Fast);
  31 __PACKAGE__->mk_accessors(qw(test));
  32
  33 package Bench::Class::Accessor::Faster;
  34 use base qw(Class::Accessor::Faster);
  35 __PACKAGE__->mk_accessors(qw(test));
  36
  37 my %init   = ( test => 23 );
  38 my $ca     = Bench::Class::Accessor->new(\%init);
  39 my $fast   = Bench::Class::Accessor::Fast->new(\%init);
  40 my $faster = Bench::Class::Accessor::Faster->new(\%init);
  41 my $direct = Bench::Direct->new;
  42 my $byhand = Bench::ByHand->new;
  43
  44 my $foo;
  45 my $control = 42;
  46
  47
  48 package main;
  49 use Benchmark 'cmpthese';
  50 use strict;
  51
  52 print "accessors:\n";
  53 cmpthese( -1,
  54            {
  55             'Basic' => sub { $foo = $ca->test; },
  56             'Fast' => sub { $foo = $fast->test; },
  57             'Faster' => sub { $foo = $faster->test; },
  58             'Average' => sub { $foo = $byhand->test; },
  59             'Direct' => sub { $foo = $direct->{test}; }
  60            }
  61          );
  62
  63 print "mutators:\n";
  64 cmpthese( -1,
  65            {
  66             'Acc' => sub { $ca->test(42); },
  67             'Fast' => sub { $fast->test(42); },
  68             'Faster' => sub { $faster->test(42); },
  69             'By hand' => sub { $byhand->test(42); },
  70             'Direct' => sub { $direct->{test} = 42; }
  71            }
  72          );
  73