Initial benchmark (totally incomplete)

[gitmo/Moo.git] / benchmark / class_factory

use strictures 1;

use Benchmark qw/:hireswallclock cmpthese/;
use Getopt::Long::Descriptive;


my ($opts, $usage);
BEGIN {
  ($opts, $usage) = describe_options(
    '%c: %o' =>
    [ 'help|h'          => 'Print usage message and exit' ],
    [ 'classes|c:i'     => 'How many classes to create per benchmark cycle (def 10)', { default => 10 } ],
    [ 'accessors|a:i'   => 'How many accessors to create per class (def 100)', { default => 100 } ],
    [ 'pregenerate|p:i' => 'For how many maximum benchmark cycles should we prepare (def 1000)', { default => 1000 } ],
    [ 'unique|u'        => 'Make accessor names globally unique (instead of just per class)' ],
    [ 'bench|b:s'       => 'Which benchmarks to run (all|xs|pp)', { default => 'all', regex => qr/^(?:all|xs|pp)$/ } ],
    { getopt_conf => [qw/gnu_getopt bundling_override no_ignore_case/] },
  );

  # can not change this runtime, thus in-block
  $ENV{MOUSE_PUREPERL} = 1 if $opts->{bench} eq 'pp';

  my @missing;
  for (qw/
    Moose
    Moo
    Mouse
  /) {
    eval "require $_" or push @missing, $_;
  }

  if (@missing) {
    die sprintf "Missing modules necessary for benchmark:\n\n%s\n\n",
      join ("\n", @missing);
  }
}

use Method::Generate::Accessor; # need to pre-load for the XS shutoff to work

$usage->die if $opts->{help};

my $counters;
my $tasks = {};

if ($opts->{bench} =~ /all|pp/) {
  {
    local $Method::Generate::Accessor::CAN_HAZ_XS = 0;
    _add_moosey_has (moo => 'Moo');
  }

  _add_moosey_has (moose => 'Moose');
  _add_moosey_has (mouse => 'Mouse')
    if $ENV{MOUSE_PUREPERL};
}

if ($opts->{bench} =~ /all|xs/) {
  {
    local $Method::Generate::Accessor::CAN_HAZ_XS = 1;
    _add_moosey_has (moo_XS => 'Moo');
  }
  _add_moosey_has (mouse_XS => 'Mouse')
    unless $ENV{MOUSE_PUREPERL};
}

# run each task once, prime whatever caches there may be
$_->() for values %$tasks;

# Actual Benchmarking
for (1, 2) {
  print "Perl $], take $_:\n";
  cmpthese ( -1, $tasks );
  print "\n";
}

exit 0; # the end

sub _add_moosey_has {
  my ($name, $base) = @_;

  my @for_eval;

  # need to pre-gen stuff so that the class names will differ for every bench run
  for (1 .. $opts->{pregenerate}) {
    my $perl;
    for ( 1.. $opts->{classes} ) {
      my $class = "Bench::${base}::" . ++$counters->{class};
      $perl .= "package $class; use $base;";
      for ( 1.. $opts->{accessors} ) {
        my $attr = 'attribute_' . ++$counters->{acc};
        $perl .= "has $attr => ( is => rw );";
      }

      $counters->{accessors} = 0
        unless $opts->{unique};
    }

    push @for_eval, $perl;
  }

  $tasks->{$name} = sub {
    my $code = shift @for_eval
      or die "Ran out of pre-generated stuff, raise -p\n";
    eval $code;
  };
}