Dogcows Code - chaz/p5-CGI-Ex/blob - samples/benchmark/bench_operator_storage.pl

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 bench_operator_storage.pl - Look at different ways of storing operators and how to call them
   6
   7 =cut
   8
   9 use strict;
  10 use Benchmark qw(cmpthese timethese);
  11 use CGI::Ex::Dump qw(debug);
  12 use constant skip_execute => 1;
  13
  14 my $total_size = eval { require Devel::Size } ? sub { Devel::Size::total_size($_[0]) } : sub { "Skip Devel::Size check" };
  15
  16 ###----------------------------------------------------------------###
  17 ### check basic setting speed - almost irrelvant as we are in the 300_000's
  18
  19 my $set_w_ref = sub { my $s = [ \ [      '+', 4, 5],  0] };
  20 my $set_undef = sub { my $s = [ [undef, '+', 4, 5],  0] };
  21 my $set_array = sub { my $s = [ [[      '+', 4, 5]], 0] };
  22 my $set_arra2 = sub { my $s = [ [[],    '+', 4, 5],  0] };
  23 my $set_bless = sub { my $s = [ bless([ '+', 4, 5],'CGI::Ex::Template::Op::foo'),  0] };
  24
  25 print "Set_w_ref size: ". $total_size->($set_w_ref->()) ."\n";
  26 print "Set_undef size: ". $total_size->($set_undef->()) ."\n";
  27 print "Set_array size: ". $total_size->($set_array->()) ."\n";
  28 print "Set_arra2 size: ". $total_size->($set_arra2->()) ."\n";
  29 print "Set_bless size: ". $total_size->($set_bless->()) ."\n";
  30
  31 cmpthese timethese -1, {
  32     set_w_ref => $set_w_ref,
  33     set_undef => $set_undef,
  34     set_array => $set_array,
  35     set_arra2 => $set_arra2,
  36     set_bless => $set_bless,
  37 };
  38
  39 ###----------------------------------------------------------------###
  40 ### time basic variable checking
  41
  42 my $check_w_ref = sub {
  43     my $s = shift;
  44     if (ref $s eq 'REF') {
  45         $s = $$s->[0] eq '..' ? 1 : 2;
  46     } else {
  47         $s = 0;
  48     }
  49 };
  50
  51 my $check_undef = sub {
  52     my $s = shift;
  53     if (! defined $s->[0]) {
  54         $s = $s->[1] eq '..' ? 1 : 2;
  55     } else {
  56         $s = 0;
  57     }
  58 };
  59
  60 cmpthese timethese -1, {
  61     w_ref_pos  => sub { $check_w_ref->(\ ['+', 4, 5]) },
  62     w_ref_dots => sub { $check_w_ref->(\ ['..', 4, 5]) },
  63     w_ref_neg  => sub { $check_w_ref->(['a', 0]) },
  64     undef_pos  => sub { $check_undef->([undef, '+', 4, 5]) },
  65     undef_dots => sub { $check_undef->([undef, '..', 4, 5]) },
  66     undef_neg  => sub { $check_undef->(['a', 0]) },
  67 };
  68
  69 ###----------------------------------------------------------------###
  70 ### check for calling speed
  71
  72 my $play_w_ref = sub {
  73     my $tree = shift;
  74     my $op   = $tree->[0];
  75     my @args = ($tree->[1], $tree->[2]);
  76 };
  77
  78 my $play_undef = sub {
  79     my $tree = shift;
  80     my $op   = $tree->[1];
  81     my @args = ($tree->[2], $tree->[3]);
  82 };
  83
  84 my $play_undef2 = sub {
  85     my $op   = shift;
  86     my @args = @_;
  87 };
  88
  89 my $call_w_ref = sub {
  90     my $s = shift;
  91     return $play_w_ref->($$s);
  92 };
  93
  94 my $call_undef = sub {
  95     my $s = shift;
  96     return $play_undef->($s);
  97 };
  98
  99 my $call_undef2 = sub {
 100     my $s = shift;
 101     return $play_undef2->(@$s[1..$#$s]);
 102 };
 103
 104
 105 cmpthese timethese -1, {
 106     small_w_ref => sub { $call_w_ref->(\ ['~', 1 .. 2]) },
 107     med___w_ref => sub { $call_w_ref->(\ ['~', 1 .. 200]) },
 108     large_w_ref => sub { $call_w_ref->(\ ['~', 1 .. 2000]) },
 109     small_undef => sub { $call_undef->([undef, '~', 1 .. 2]) },
 110     med___undef => sub { $call_undef->([undef, '~', 1 .. 200]) },
 111     large_undef => sub { $call_undef->([undef, '~', 1 .. 2000]) },
 112     small_undef2 => sub { $call_undef2->([undef, '~', 1 .. 2]) },
 113     med___undef2 => sub { $call_undef2->([undef, '~', 1 .. 200]) },
 114     large_undef2 => sub { $call_undef2->([undef, '~', 1 .. 2000]) },
 115 };