]> git.vpit.fr Git - perl/modules/autovivification.git/blob - samples/bench.pl
Update the ActivePerl/gcc-3.4 hack for EUMM 7.04
[perl/modules/autovivification.git] / 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 }