samples/bench.pl

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Benchmark qw<:hireswallclock cmpthese>;
   7
   8 use blib;
   9
  10 my $count = -1;
  11
  12 my @tests;
  13
  14 {
  15  my %h = ();
  16
  17  push @tests, [
  18   'Fetch a non-existing key from a hash',
  19   {
  20    av   => sub { $h{a} },
  21    noav => sub { no autovivification; $h{a} },
  22   }
  23  ];
  24 }
  25
  26 {
  27  my %h = (a => 1);
  28
  29  push @tests, [
  30   'Fetch an existing key from a hash',
  31   {
  32    av   => sub { $h{a} },
  33    noav => sub { no autovivification; $h{a} },
  34   }
  35  ];
  36 }
  37
  38 {
  39  my $x = { };
  40
  41  push @tests, [
  42   'Fetch a non-existing key from a hash reference',
  43   {
  44    av          => sub { $x->{a} },
  45    noav        => sub { no autovivification; $x->{a} },
  46    noav_manual => sub { defined $x ? $x->{a} : undef },
  47   }
  48  ];
  49 }
  50
  51 {
  52  my $x = { a => 1 };
  53
  54  push @tests, [
  55   'Fetch an existing key from a hash reference',
  56   {
  57    av          => sub { $x->{a} },
  58    noav        => sub { no autovivification; $x->{a} },
  59    noav_manual => sub { defined $x ? $x->{a} : undef },
  60   }
  61  ];
  62 }
  63
  64 {
  65  my $x = { a => { b => { c => { d => 1 } } } };
  66
  67  push @tests, [
  68   'Fetch a 4-levels deep existing key from a hash reference',
  69   {
  70    av          => sub { $x->{a}{b}{c}{d} },
  71    noav        => sub { no autovivification; $x->{a}{b}{c}{d} },
  72    noav_manual => sub { my $z; defined $x ? ($z = $x->{a}, defined $z ? ($z = $z->{b}, defined $z ? ($z = $z->{c}, defined $z ? $z->{d} : undef) : undef) : undef) : undef },
  73   }
  74  ];
  75 }
  76
  77 {
  78  my $x = { };
  79  $x->{$_} = undef       for 100 .. 199;
  80  $x->{$_} = { $_ => 1 } for 200 .. 299;
  81  my $n = 0;
  82
  83  no warnings 'void';
  84
  85  push @tests, [
  86   'Fetch 2-levels deep existing or non-existing keys from a hash reference',
  87   {
  88    inc         => sub { $n = ($n+1) % 300 },
  89    av          => sub { $x->{$n}{$n}; $n = ($n+1) % 300 },
  90    noav        => sub { no autovivification; $x->{$n}{$n}; $n = ($n+1) % 300 },
  91    noav_manual => sub { my $z; defined $x ? ($z = $x->{a}, (defined $z ? $z->{b} : undef)) : undef; $n = ($n + 1) % 300 },
  92   }
  93  ];
  94 }
  95
  96 for my $t (@tests) {
  97  printf "--- %s ---\n", $t->[0];
  98  cmpthese $count, $t->[1];
  99  print "\n";
 100 }