t/benchmark/rt26188-speed-up-keys-on-empty-hash.t

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use Benchmark;
   4 chdir 't' if -d 't';
   5 require './test.pl';
   6 plan(tests => 6);
   7
   8 =head1 NAME
   9
  10 rt26188 - benchmark speed for keys() on empty hashes
  11
  12 =head1 DESCRIPTION
  13
  14 If you have an empty hash, the speed of keys() depends
  15 on how many keys the hash previously held.
  16
  17 For global hashes, getting the count for previously
  18 big hashes was substantially slower than for lexical hashes.
  19
  20 This test checks that the speed difference for getting
  21 the 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
  26 This test tests against RT ticket #26188
  27
  28 L<http://rt.perl.org/rt3/Public/Bug/Display.html?id=26188>
  29
  30 =cut
  31
  32 use vars qw(%h_big %h_small);
  33 my %l_big = (1..50000);
  34 my %l_small = (1..10);
  35
  36 %h_big = (1..50000);
  37 %h_small = (1..10);
  38
  39 delete @h_big{keys %h_big};
  40 delete @h_small{keys %h_small};
  41 delete @l_big{keys %l_big};
  42 delete @l_small{keys %l_small};
  43
  44 my $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
  56 sub iters_per_second {
  57     $_[0]->iters / $_[0]->cpu_p
  58 }
  59
  60 sub 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
  72 about_as_fast_ok( $res, 'scalar_big', 'scalar_small',"Checking the count of hash keys in an empty hash (global)");
  73
  74 about_as_fast_ok( $res, 'big', 'small', "Checking the list of hash keys in an empty hash (global)");
  75
  76 about_as_fast_ok( $res, 'lex_scalar_big', 'lex_scalar_small',"Checking the count of hash keys in an empty hash (lexical)");
  77
  78 about_as_fast_ok( $res, 'lex_big', 'lex_small', "Checking the list of hash keys in an empty hash (lexical)");
  79
  80 about_as_fast_ok( $res, 'lex_scalar_big', 'scalar_big',"Checking the count of hash keys in an empty hash, global vs. lexical");
  81
  82 about_as_fast_ok( $res, 'lex_big', 'big', "Checking the list of hash keys in an empty hash, global vs. lexical");
  83
  84 __END__