Prevent premature hsplit() calls, and only trigger REHASH after hsplit()
[perl.git] / ext / Hash-Util-FieldHash / t / 10_hash.t
1 #!./perl -w
2
3 BEGIN {
4     if ($ENV{PERL_CORE}) {
5         chdir 't' if -d 't';
6         @INC = '../lib';
7     }
8 }
9
10 use Test::More;
11
12 use strict;
13 use Hash::Util::FieldHash qw( :all);
14
15 no warnings 'misc';
16
17 plan tests => 5;
18
19 fieldhash my %h;
20
21 ok (!Internals::HvREHASH(%h), "hash doesn't start with rehash flag on");
22
23 foreach (1..10) {
24   $h{"\0"x$_}++;
25 }
26
27 ok (!Internals::HvREHASH(%h), "10 entries doesn't trigger rehash");
28
29 foreach (11..20) {
30   $h{"\0"x$_}++;
31 }
32
33 ok (Internals::HvREHASH(%h), "20 entries triggers rehash");
34
35
36
37
38 # second part using an emulation of the PERL_HASH in perl, mounting an
39 # attack on a pre-populated hash. This is also useful if you need normal
40 # keys which don't contain \0 -- suitable for stashes
41
42 use constant MASK_U32  => 2**32;
43 use constant HASH_SEED => 0;
44 use constant THRESHOLD => 14;
45 use constant START     => "a";
46
47 # some initial hash data
48 fieldhash my %h2;
49 my $counter= "a";
50 $h2{$counter++}++ while $counter ne 'cd';
51
52 ok (!Internals::HvREHASH(%h2), 
53     "starting with pre-populated non-pathological hash (rehash flag if off)");
54
55 my @keys = get_keys(\%h2);
56 my $buckets= buckets(\%h2);
57 $h2{$_}++ for @keys;
58 $h2{$counter++}++ while buckets(\%h2) == $buckets; # force a split
59 ok (Internals::HvREHASH(%h2), 
60     scalar(@keys) . " colliding into the same bucket keys are triggering rehash after split");
61
62 # returns the number of buckets in a hash
63 sub buckets {
64     my $hr = shift;
65     my $keys_buckets= scalar(%$hr);
66     if ($keys_buckets=~m!/([0-9]+)\z!) {
67         return 0+$1;
68     } else {
69         return 8;
70     }
71 }
72
73 sub get_keys {
74     my $hr = shift;
75
76     # the minimum of bits required to mount the attack on a hash
77     my $min_bits = log(THRESHOLD)/log(2);
78
79     # if the hash has already been populated with a significant amount
80     # of entries the number of mask bits can be higher
81     my $keys = scalar keys %$hr;
82     my $bits = $keys ? log($keys)/log(2) : 0;
83     $bits = $min_bits if $min_bits > $bits;
84
85     $bits = int($bits) < $bits ? int($bits) + 1 : int($bits);
86     # need to add 2 bits to cover the internal split cases
87     $bits += 2;
88     my $mask = 2**$bits-1;
89     print "# using mask: $mask ($bits)\n";
90
91     my @keys;
92     my $s = START;
93     my $c = 0;
94     # get 2 keys on top of the THRESHOLD
95     my $hash;
96     while (@keys < THRESHOLD+2) {
97         # next if exists $hash->{$s};
98         $hash = hash($s);
99         next unless ($hash & $mask) == 0;
100         $c++;
101         printf "# %2d: %5s, %10s\n", $c, $s, $hash;
102         push @keys, $s;
103     } continue {
104         $s++;
105     }
106
107     return @keys;
108 }
109
110
111 # trying to provide the fastest equivalent of C macro's PERL_HASH in
112 # Perl - the main complication is that it uses U32 integer, which we
113 # can't do it perl, without doing some tricks
114 sub hash {
115     my $s = shift;
116     my @c = split //, $s;
117     my $u = HASH_SEED;
118     for (@c) {
119         # (A % M) + (B % M) == (A + B) % M
120         # This works because '+' produces a NV, which is big enough to hold
121         # the intermediate result. We only need the % before any "^" and "&"
122         # to get the result in the range for an I32.
123         # and << doesn't work on NV, so using 1 << 10
124         $u += ord;
125         $u += $u * (1 << 10); $u %= MASK_U32;
126         $u ^= $u >> 6;
127     }
128     $u += $u << 3;  $u %= MASK_U32;
129     $u ^= $u >> 11; $u %= MASK_U32;
130     $u += $u << 15; $u %= MASK_U32;
131     $u;
132 }