1#!/usr/bin/perl -w
2use strict;
3use Benchmark;
4chdir 't' if -d 't';
5require './test.pl';
6plan(tests => 6);
7
8=head1 NAME
9
10gh7094 - benchmark speed for keys() on empty hashes
11
12=head1 DESCRIPTION
13
14If you have an empty hash, the speed of keys() depends
15on how many keys the hash previously held.
16
17For global hashes, getting the count for previously
18big hashes was substantially slower than for lexical hashes.
19
20This test checks that the speed difference for getting
21the number or list of keys from an empty hash is about the same
22(< 25%) for lexical and global hashes, both previously big and small.
23
24=head1 REFERENCE
25
26This test tests against GitHub ticket #7094
27
28L<https://github.com/Perl/perl5/issues/7094>
29
30=cut
31
32use vars qw(%h_big %h_small);
33my %l_big = (1..50000);
34my %l_small = (1..10);
35
36%h_big = (1..50000);
37%h_small = (1..10);
38
39delete @h_big{keys %h_big};
40delete @h_small{keys %h_small};
41delete @l_big{keys %l_big};
42delete @l_small{keys %l_small};
43
44my $res = timethese shift || -3, {
45    big => '1 for keys %h_big',
46    small => '1 for keys %h_small',
47    scalar_big => '$a = keys %h_big',
48    scalar_small => '$a = keys %h_small',
49
50    lex_big => '1 for keys %l_big',
51    lex_small => '1 for keys %l_small',
52    lex_scalar_big => '$a = keys %l_big',
53    lex_scalar_small => '$a = keys %l_small',
54}, 'none';
55
56sub iters_per_second {
57    $_[0]->iters / $_[0]->cpu_p
58}
59
60sub about_as_fast_ok {
61    my ($res, $key1, $key2, $name) = @_;
62    $name ||= "Speed difference between $key1 and $key2 is less than 25%";
63    my %iters_per_second = map { $_ => iters_per_second( $res->{ $_ }) } ($key1, $key2);
64
65    my $ratio = abs(1 - $iters_per_second{ $key1 } / ($iters_per_second{ $key2 } || 1 ));
66    if (! cmp_ok( $ratio, '<', 0.25, $name )) {
67        diag( sprintf "%20s: %12.2f/s\n", $key1, $iters_per_second{ $key1 } );
68        diag( sprintf "%20s: %12.2f/s\n", $key2, $iters_per_second{ $key2 } );
69    };
70};
71
72about_as_fast_ok( $res, 'scalar_big', 'scalar_small',"Checking the count of hash keys in an empty hash (global)");
73
74about_as_fast_ok( $res, 'big', 'small', "Checking the list of hash keys in an empty hash (global)");
75
76about_as_fast_ok( $res, 'lex_scalar_big', 'lex_scalar_small',"Checking the count of hash keys in an empty hash (lexical)");
77
78about_as_fast_ok( $res, 'lex_big', 'lex_small', "Checking the list of hash keys in an empty hash (lexical)");
79
80about_as_fast_ok( $res, 'lex_scalar_big', 'scalar_big',"Checking the count of hash keys in an empty hash, global vs. lexical");
81
82about_as_fast_ok( $res, 'lex_big', 'big', "Checking the list of hash keys in an empty hash, global vs. lexical");
83
84__END__
85