From: Vincent Pit <vince@profvince.com>
Date: Mon, 21 Jun 2010 22:50:03 +0000 (+0200)
Subject: Improve the benchmark
X-Git-Tag: rt62800~11
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=da39e01d3032ae20f5efef06052231d53d98dc9e;p=perl%2Fmodules%2Fautovivification.git

Improve the benchmark
---

diff --git a/samples/bench.pl b/samples/bench.pl
index 9b0f173..28aa263 100644
--- a/samples/bench.pl
+++ b/samples/bench.pl
@@ -3,57 +3,98 @@
 use strict;
 use warnings;
 
-use Benchmark qw/cmpthese/;
+use Benchmark qw/:hireswallclock cmpthese/;
 
 use blib;
 
 my $count = -1;
 
-{
- my %h = (
-  a => 1,
- );
-
- cmpthese $count, {
-  fetch_hash_existing_av   => sub { $h{a} },
-  fetch_hash_existing_noav => sub { no autovivification; $h{a} },
- };
-}
+my @tests;
 
 {
  my %h = ();
 
- cmpthese $count, {
-  fetch_hash_nonexisting_av   => sub { $h{a} },
-  fetch_hash_nonexisting_noav => sub { no autovivification; $h{a} },
- };
+ push @tests, [
+  'Fetch a non-existing key from a hash',
+  {
+   av   => sub { $h{a} },
+   noav => sub { no autovivification; $h{a} },
+  }
+ ];
 }
 
 {
- my $x = {
-  a => 1,
- };
-
- cmpthese $count, {
-  fetch_hashref_existing_av   => sub { $x->{a} },
-  fetch_hashref_existing_noav => sub { no autovivification; $x->{a} },
- };
+ my %h = (a => 1);
+
+ push @tests, [
+  'Fetch an existing key from a hash',
+  {
+   av   => sub { $h{a} },
+   noav => sub { no autovivification; $h{a} },
+  }
+ ];
 }
 
 {
  my $x = { };
 
- cmpthese $count, {
-  fetch_hashref_nonexisting_av   => sub { $x->{a} },
-  fetch_hashref_nonexisting_noav => sub { no autovivification; $x->{a} },
- };
+ push @tests, [
+  'Fetch a non-existing key from a hash reference',
+  {
+   av          => sub { $x->{a} },
+   noav        => sub { no autovivification; $x->{a} },
+   noav_manual => sub { defined $x ? $x->{a} : undef },
+  }
+ ];
+}
+
+{
+ my $x = { a => 1 };
+
+ push @tests, [
+  'Fetch an existing key from a hash reference',
+  {
+   av          => sub { $x->{a} },
+   noav        => sub { no autovivification; $x->{a} },
+   noav_manual => sub { defined $x ? $x->{a} : undef },
+  }
+ ];
 }
 
 {
  my $x = { a => { b => { c => { d => 1 } } } };
 
- cmpthese $count, {
-  fetch_hashref4_existing_av   => sub { $x->{a}{b}{c}{d} },
-  fetch_hashref4_existing_noav => sub { no autovivification; $x->{a}{b}{c}{d} },
- };
+ push @tests, [
+  'Fetch a 4-levels deep existing key from a hash reference',
+  {
+   av          => sub { $x->{a}{b}{c}{d} },
+   noav        => sub { no autovivification; $x->{a}{b}{c}{d} },
+   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 },
+  }
+ ];
+}
+
+{
+ my $x = { };
+ $x->{$_} = undef       for 100 .. 199;
+ $x->{$_} = { $_ => 1 } for 200 .. 299;
+ my $n = 0;
+
+ no warnings 'void';
+
+ push @tests, [
+  'Fetch 2-levels deep existing or non-existing keys from a hash reference',
+  {
+   inc         => sub { $n = ($n+1) % 300 },
+   av          => sub { $x->{$n}{$n}; $n = ($n+1) % 300 },
+   noav        => sub { no autovivification; $x->{$n}{$n}; $n = ($n+1) % 300 },
+   noav_manual => sub { my $z; defined $x ? ($z = $x->{a}, (defined $z ? $z->{b} : undef)) : undef; $n = ($n + 1) % 300 },
+  }
+ ];
+}
+
+for my $t (@tests) {
+ printf "--- %s ---\n", $t->[0];
+ cmpthese $count, $t->[1];
+ print "\n";
 }