Commit | Line | Data |
---|---|---|
58da6fbc MM |
1 | #!/usr/bin/perl -w |
2 | use strict; | |
3 | use Benchmark; | |
4 | require './test.pl'; | |
58da6fbc MM |
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 | */ | |
1b95d04f | 89 | if (! HvUSEDKEYS(hv) && !(flags & HV_ITERNEXT_WANTPLACEHOLDERS) ) |
58da6fbc | 90 | return NULL; |