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