1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
#!perl
use strict;
use warnings;
use Benchmark qw<:hireswallclock cmpthese>;
use blib;
my $count = -1;
my @tests;
{
my %h = ();
push @tests, [
'Fetch a non-existing key from a hash',
{
av => sub { $h{a} },
noav => sub { no autovivification; $h{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 = { };
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 } } } };
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";
}
|
