1#!perl
2
3use strict;
4use warnings;
5
6use Benchmark qw<:hireswallclock cmpthese>;
7
8use blib;
9
10my $count = -1;
11
12my @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
96for my $t (@tests) {
97 printf "--- %s ---\n", $t->[0];
98 cmpthese $count, $t->[1];
99 print "\n";
100}
101