Commit | Line | Data |
58da6fbc |
1 | #!/usr/bin/perl -w |
2 | use strict; |
3 | use Benchmark; |
4 | require './test.pl'; |
58da6fbc |
5 | plan(tests => 6); |
6 | |
7 | =head1 NAME |
8 | |
9 | rt26188 - benchmark speed for keys() on empty hashes |
10 | |
11 | =head1 DESCRIPTION |
12 | |
13 | If you have an empty hash, the speed of keys() depends |
14 | on how many keys the hash previously held. |
15 | |
16 | For global hashes, getting the count for previously |
17 | big hashes was substantially slower than for lexical hashes. |
18 | |
19 | This test checks that the speed difference for getting |
20 | the number or list of keys from an empty hash is about the same |
21 | (< 25%) for lexical and global hashes, both previously big and small. |
22 | |
23 | =head1 REFERENCE |
24 | |
25 | This test tests against RT ticket #26188 |
26 | |
27 | L<http://rt.perl.org/rt3/Public/Bug/Display.html?id=26188> |
28 | |
29 | =cut |
30 | |
31 | use vars qw(%h_big %h_small); |
32 | my %l_big = (1..50000); |
33 | my %l_small = (1..10); |
34 | |
35 | %h_big = (1..50000); |
36 | %h_small = (1..10); |
37 | |
38 | delete @h_big{keys %h_big}; |
39 | delete @h_small{keys %h_small}; |
40 | delete @l_big{keys %l_big}; |
41 | delete @l_small{keys %l_small}; |
42 | |
43 | my $res = timethese shift || -3, { |
44 | big => '1 for keys %h_big', |
45 | small => '1 for keys %h_small', |
46 | scalar_big => '$a = keys %h_big', |
47 | scalar_small => '$a = keys %h_small', |
48 | |
49 | lex_big => '1 for keys %l_big', |
50 | lex_small => '1 for keys %l_small', |
51 | lex_scalar_big => '$a = keys %l_big', |
52 | lex_scalar_small => '$a = keys %l_small', |
53 | }, 'none'; |
54 | |
55 | sub iters_per_second { |
56 | $_[0]->iters / $_[0]->cpu_p |
57 | } |
58 | |
59 | sub about_as_fast_ok { |
60 | my ($res, $key1, $key2, $name) = @_; |
61 | $name ||= "Speed difference between $key1 and $key2 is less than 25%"; |
62 | my %iters_per_second = map { $_ => iters_per_second( $res->{ $_ }) } ($key1, $key2); |
63 | |
64 | my $ratio = abs(1 - $iters_per_second{ $key1 } / ($iters_per_second{ $key2 } || 1 )); |
65 | if (! cmp_ok( $ratio, '<', 0.25, $name )) { |
66 | diag( sprintf "%20s: %12.2f/s\n", $key1, $iters_per_second{ $key1 } ); |
67 | diag( sprintf "%20s: %12.2f/s\n", $key2, $iters_per_second{ $key2 } ); |
68 | }; |
69 | }; |
70 | |
71 | about_as_fast_ok( $res, 'scalar_big', 'scalar_small',"Checking the count of hash keys in an empty hash (global)"); |
72 | |
73 | about_as_fast_ok( $res, 'big', 'small', "Checking the list of hash keys in an empty hash (global)"); |
74 | |
75 | about_as_fast_ok( $res, 'lex_scalar_big', 'lex_scalar_small',"Checking the count of hash keys in an empty hash (lexical)"); |
76 | |
77 | about_as_fast_ok( $res, 'lex_big', 'lex_small', "Checking the list of hash keys in an empty hash (lexical)"); |
78 | |
79 | about_as_fast_ok( $res, 'lex_scalar_big', 'scalar_big',"Checking the count of hash keys in an empty hash, global vs. lexical"); |
80 | |
81 | about_as_fast_ok( $res, 'lex_big', 'big', "Checking the list of hash keys in an empty hash, global vs. lexical"); |
82 | |
83 | __END__ |
84 | |
85 | # code written |
86 | /* quick bailout if the hash is empty anyway. |
87 | I don't know if placeholders are included in the KEYS count, so a defensive check |
88 | */ |
89 | if (! HvKEYS(hv) && !(flags & HV_ITERNEXT_WANTPLACEHOLDERS) ) |
90 | return NULL; |