annihilate Moo since this is going to be the Role-Tiny repo now
[gitmo/Role-Tiny.git] / benchmark / object_factory
diff --git a/benchmark/object_factory b/benchmark/object_factory
deleted file mode 100644 (file)
index c539c14..0000000
+++ /dev/null
@@ -1,156 +0,0 @@
-use strictures 1;
-
-use Benchmark qw/:hireswallclock cmpthese/;
-use Getopt::Long::Descriptive;
-
-use Config;
-
-my $attrs_to_bench = {
-  plain =>              q|is => 'rw'                                                      |,
-  ro =>                 q|is => 'ro'                                                      |,
-  default =>            q|is => 'rw', default => sub { {} }                               |,
-  lazy_default =>       q|is => 'rw', lazy => 1, default => sub { {} }                    |,
-  lazy_default_qsub =>  q|is => 'rw', lazy => 1, default => Sub::Quote::quote_sub q{ {} } |,
-};
-
-my $cycles = {
-  1 => 'get',
-  2 => 'get/set/get',
-};
-
-my ($opts, $usage) = describe_options(
-  '%c: %o' =>
-  [ 'help|h'          => 'Print usage message and exit' ],
-  [ 'bench|b:s'       => 'Which benchmarks to run (all|xs|pp)', { default => 'all', regex => qr/^(?:all|xs|pp)$/ } ],
-  [ 'lib|l:s@'        => 'Bench against specific lib(s), runs same benches against multiple targets, excluding non-moo benches' ],
-  [ 'attr|a:s@'       => 'Which attributes to benchmark (must be defined in-file)' ],
-  [ 'cycle|c:i'       => 'Which cycle to run 1 - get, 2 - get/set/get (def 1)', { default => 1 } ],
-  [ 'iterations|i:i'  => 'How many iterations in each bench run (def 1000)', { default => 1000 } ],
-  [ 'totalruns|total|t:i' => 'How many times to rerun the whole benchmark (def 1)', { default => 1 } ],
-  [ 'reuse|r'         => 'Reuse the object between attribute usage runs' ],
-  { getopt_conf => [qw/gnu_getopt bundling_override no_ignore_case/] },
-);
-
-$usage->die if $opts->{help};
-
-if ($opts->{attr}) {
-  my %to_bench = map { $_ => 1 } map { split /\s*,\s*/, $_ } @{$opts->{attr}};
-
-  for (keys %to_bench) {
-    die "No such attr '$_'\n" unless $attrs_to_bench->{$_};
-  }
-
-  for (keys %$attrs_to_bench) {
-    delete $attrs_to_bench->{$_} unless $to_bench{$_};
-  }
-}
-
-my @libs = map { split /\s*:\s*/, $_ } @{$opts->{lib}}
-  if ($opts->{lib});
-
-if (@libs) {
-  my $myself = $$;
-
-  for my $lib (@libs) {
-    $ENV{PERL5LIB} = join ($Config{path_sep}, $lib, @INC);
-
-    my $pid = fork();
-    die "Unable to fork: $!" unless defined $pid;
-
-    if ($pid) {
-      wait;
-    }
-    else {
-      print "Benchmarking with $lib\n";
-      last;
-    }
-  }
-
-  exit 0 if $$ == $myself;
-}
-
-require Method::Generate::Accessor; # need to pre-load for the XS shut-off to work
-
-my $class_types;
-
-if ($opts->{bench} =~ /all|pp/) {
-  {
-    local $Method::Generate::Accessor::CAN_HAZ_XS = 0;
-    _add_moosey_has (moo => 'Moo');
-  }
-
-  _add_moosey_has (moose => 'Moose') unless @libs;
-  _add_moosey_has (mouse => 'Mousse') unless @libs;
-}
-
-if ($opts->{bench} =~ /all|xs/) {
-  if (! $Method::Generate::Accessor::CAN_HAZ_XS)
-  {
-    die "Requested XS benchmarks but XS isn't available in Method::Generate::Accessor";
-  }
-
-  _add_moosey_has (moo_XS => 'Moo');
-  _add_moosey_has (mouse_XS => 'Mouse') unless @libs;
-}
-
-
-# Actual Benchmarking
-for (1 .. $opts->{totalruns} ) {
-  print "Perl $], take $_:\n";
-
-  my $objects;
-
-  for my $use_attrs (0, 1) {
-    for my $attr (keys %$attrs_to_bench) {
-      printf "\n\nBenching %s ( %s )\n====================\n",
-        $attr,
-        $use_attrs
-          ? sprintf '%s%s cycle', ($opts->{reuse} ? '' : 'new() and ' ), $cycles->{$opts->{cycle}}
-          : 'new() only'
-        ,
-      ;
-
-      cmpthese ( -1, { map {
-        my $type = $_;
-        "${type}->$attr" => sub {
-          $objects->{$type} = $class_types->{$type}->new
-            unless ( $use_attrs && $opts->{reuse} );
-
-          for (1 .. $opts->{iterations} ) {
-            if ($opts->{cycle} == 1) {
-              my $init = $objects->{$type}->$attr;
-            }
-            elsif ($opts->{cycle} == 2) {
-              my $init = $objects->{$type}->$attr;
-              $objects->{$type}->$attr('foo') unless $attr eq 'ro';
-              my $set = $objects->{$type}->$attr;
-            }
-          }
-        };
-      } keys %$class_types } );
-    }
-  }
-
-  print "\n\n\n";
-}
-
-exit 0; # the end
-
-sub _add_moosey_has {
-  my ($name, $base) = @_;
-
-  my $class = "Bench::${name}";
-
-  my $perl = "package $class; use $base;";
-
-  for my $attr (keys %$attrs_to_bench) {
-    $perl .= "has $attr => ($attrs_to_bench->{$attr});";
-
-    $class_types->{$name} = $class;
-  }
-
-  $perl .= 'eval { __PACKAGE__->meta->make_immutable };';
-
-  eval $perl;
-  die $@ if $@;
-}