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