Hash Function Change - Murmur hash and true per process hash seed
[perl.git] / ext / Hash-Util / t / Util.t
1 #!/usr/bin/perl -Tw
2
3 BEGIN {
4     if ($ENV{PERL_CORE}) {
5         require Config; import Config;
6         no warnings 'once';
7         if ($Config{extensions} !~ /\bHash\/Util\b/) {
8             print "1..0 # Skip: Hash::Util was not built\n";
9             exit 0;
10         }
11     }
12 }
13
14 use strict;
15 use Test::More;
16 my @Exported_Funcs;
17 BEGIN {
18     @Exported_Funcs = qw(
19                      fieldhash fieldhashes
20
21                      all_keys
22                      lock_keys unlock_keys
23                      lock_value unlock_value
24                      lock_hash unlock_hash
25                      lock_keys_plus
26                      hash_locked hash_unlocked
27                      hashref_locked hashref_unlocked
28                      hidden_keys legal_keys
29
30                      lock_ref_keys unlock_ref_keys
31                      lock_ref_value unlock_ref_value
32                      lock_hashref unlock_hashref
33                      lock_ref_keys_plus
34                      hidden_ref_keys legal_ref_keys
35
36                      hash_seed hash_value bucket_stats bucket_info bucket_array
37                      hv_store
38                      lock_hash_recurse unlock_hash_recurse
39                     );
40     plan tests => 234 + @Exported_Funcs;
41     use_ok 'Hash::Util', @Exported_Funcs;
42 }
43 foreach my $func (@Exported_Funcs) {
44     can_ok __PACKAGE__, $func;
45 }
46
47 my %hash = (foo => 42, bar => 23, locked => 'yep');
48 lock_keys(%hash);
49 eval { $hash{baz} = 99; };
50 like( $@, qr/^Attempt to access disallowed key 'baz' in a restricted hash/,
51                                                        'lock_keys()');
52 is( $hash{bar}, 23, '$hash{bar} == 23' );
53 ok( !exists $hash{baz},'!exists $hash{baz}' );
54
55 delete $hash{bar};
56 ok( !exists $hash{bar},'!exists $hash{bar}' );
57 $hash{bar} = 69;
58 is( $hash{bar}, 69 ,'$hash{bar} == 69');
59
60 eval { () = $hash{i_dont_exist} };
61 like( $@, qr/^Attempt to access disallowed key 'i_dont_exist' in a restricted hash/,
62       'Disallowed 1' );
63
64 lock_value(%hash, 'locked');
65 eval { print "# oops" if $hash{four} };
66 like( $@, qr/^Attempt to access disallowed key 'four' in a restricted hash/,
67       'Disallowed 2' );
68
69 eval { $hash{"\x{2323}"} = 3 };
70 like( $@, qr/^Attempt to access disallowed key '(.*)' in a restricted hash/,
71                                                'wide hex key' );
72
73 eval { delete $hash{locked} };
74 like( $@, qr/^Attempt to delete readonly key 'locked' from a restricted hash/,
75                                            'trying to delete a locked key' );
76 eval { $hash{locked} = 42; };
77 like( $@, qr/^Modification of a read-only value attempted/,
78                                            'trying to change a locked key' );
79 is( $hash{locked}, 'yep', '$hash{locked} is yep' );
80
81 eval { delete $hash{I_dont_exist} };
82 like( $@, qr/^Attempt to delete disallowed key 'I_dont_exist' from a restricted hash/,
83                              'trying to delete a key that doesnt exist' );
84
85 ok( !exists $hash{I_dont_exist},'!exists $hash{I_dont_exist}' );
86
87 unlock_keys(%hash);
88 $hash{I_dont_exist} = 42;
89 is( $hash{I_dont_exist}, 42,    'unlock_keys' );
90
91 eval { $hash{locked} = 42; };
92 like( $@, qr/^Modification of a read-only value attempted/,
93                              '  individual key still readonly' );
94 eval { delete $hash{locked} },
95 is( $@, '', '  but can be deleted :(' );
96
97 unlock_value(%hash, 'locked');
98 $hash{locked} = 42;
99 is( $hash{locked}, 42,  'unlock_value' );
100
101
102 {
103     my %hash = ( foo => 42, locked => 23 );
104
105     lock_keys(%hash);
106     eval { %hash = ( wubble => 42 ) };  # we know this will bomb
107     like( $@, qr/^Attempt to access disallowed key 'wubble'/,'Disallowed 3' );
108     unlock_keys(%hash);
109 }
110
111 {
112     my %hash = (KEY => 'val', RO => 'val');
113     lock_keys(%hash);
114     lock_value(%hash, 'RO');
115
116     eval { %hash = (KEY => 1) };
117     like( $@, qr/^Attempt to delete readonly key 'RO' from a restricted hash/,
118         'attempt to delete readonly key from restricted hash' );
119 }
120
121 {
122     my %hash = (KEY => 1, RO => 2);
123     lock_keys(%hash);
124     eval { %hash = (KEY => 1, RO => 2) };
125     is( $@, '', 'No error message, as expected');
126 }
127
128 {
129     my %hash = ();
130     lock_keys(%hash, qw(foo bar));
131     is( keys %hash, 0,  'lock_keys() w/keyset shouldnt add new keys' );
132     $hash{foo} = 42;
133     is( keys %hash, 1, '1 element in hash' );
134     eval { $hash{wibble} = 42 };
135     like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/,
136                         'write threw error (locked)');
137
138     unlock_keys(%hash);
139     eval { $hash{wibble} = 23; };
140     is( $@, '', 'unlock_keys' );
141 }
142
143 {
144     my %hash = (foo => 42, bar => undef, baz => 0);
145     lock_keys(%hash, qw(foo bar baz up down));
146     is( keys %hash, 3,   'lock_keys() w/keyset didnt add new keys' );
147     is_deeply( \%hash, { foo => 42, bar => undef, baz => 0 },'is_deeply' );
148
149     eval { $hash{up} = 42; };
150     is( $@, '','No error 1' );
151
152     eval { $hash{wibble} = 23 };
153     like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/,
154           'locked "wibble"' );
155 }
156
157 {
158     my %hash = (foo => 42, bar => undef);
159     eval { lock_keys(%hash, qw(foo baz)); };
160     like( $@, qr/^Hash has key 'bar' which is not in the new key set/,
161                     'carp test' );
162 }
163
164 {
165     my %hash = (foo => 42, bar => 23);
166     lock_hash( %hash );
167     ok( hashref_locked( \%hash ), 'hashref_locked' );
168     ok( hash_locked( %hash ), 'hash_locked' );
169
170     ok( Internals::SvREADONLY(%hash),'Was locked %hash' );
171     ok( Internals::SvREADONLY($hash{foo}),'Was locked $hash{foo}' );
172     ok( Internals::SvREADONLY($hash{bar}),'Was locked $hash{bar}' );
173
174     unlock_hash ( %hash );
175     ok( hashref_unlocked( { %hash } ), 'hashref_unlocked' );
176     ok( hash_unlocked( %hash ), 'hash_unlocked' );
177
178     ok( !Internals::SvREADONLY(%hash),'Was unlocked %hash' );
179     ok( !Internals::SvREADONLY($hash{foo}),'Was unlocked $hash{foo}' );
180     ok( !Internals::SvREADONLY($hash{bar}),'Was unlocked $hash{bar}' );
181 }
182
183 {
184     my %hash = (foo => 42, bar => 23);
185     ok( ! hashref_locked( { %hash } ), 'hashref_locked negated' );
186     ok( ! hash_locked( %hash ), 'hash_locked negated' );
187
188     lock_hash( %hash );
189     ok( ! hashref_unlocked( \%hash ), 'hashref_unlocked negated' );
190     ok( ! hash_unlocked( %hash ), 'hash_unlocked negated' );
191 }
192
193 lock_keys(%ENV);
194 eval { () = $ENV{I_DONT_EXIST} };
195 like(
196     $@,
197     qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/,
198     'locked %ENV'
199 );
200
201 {
202     my %hash;
203
204     lock_keys(%hash, 'first');
205
206     is (scalar keys %hash, 0, "place holder isn't a key");
207     $hash{first} = 1;
208     is (scalar keys %hash, 1, "we now have a key");
209     delete $hash{first};
210     is (scalar keys %hash, 0, "now no key");
211
212     unlock_keys(%hash);
213
214     $hash{interregnum} = 1.5;
215     is (scalar keys %hash, 1, "key again");
216     delete $hash{interregnum};
217     is (scalar keys %hash, 0, "no key again");
218
219     lock_keys(%hash, 'second');
220
221     is (scalar keys %hash, 0, "place holder isn't a key");
222
223     eval {$hash{zeroeth} = 0};
224     like ($@,
225           qr/^Attempt to access disallowed key 'zeroeth' in a restricted hash/,
226           'locked key never mentioned before should fail');
227     eval {$hash{first} = -1};
228     like ($@,
229           qr/^Attempt to access disallowed key 'first' in a restricted hash/,
230           'previously locked place holders should also fail');
231     is (scalar keys %hash, 0, "and therefore there are no keys");
232     $hash{second} = 1;
233     is (scalar keys %hash, 1, "we now have just one key");
234     delete $hash{second};
235     is (scalar keys %hash, 0, "back to zero");
236
237     unlock_keys(%hash); # We have deliberately left a placeholder.
238
239     $hash{void} = undef;
240     $hash{nowt} = undef;
241
242     is (scalar keys %hash, 2, "two keys, values both undef");
243
244     lock_keys(%hash);
245
246     is (scalar keys %hash, 2, "still two keys after locking");
247
248     eval {$hash{second} = -1};
249     like ($@,
250           qr/^Attempt to access disallowed key 'second' in a restricted hash/,
251           'previously locked place holders should fail');
252
253     is ($hash{void}, undef,
254         "undef values should not be misunderstood as placeholders");
255     is ($hash{nowt}, undef,
256         "undef values should not be misunderstood as placeholders (again)");
257 }
258
259 {
260   # perl #18651 - tim@consultix-inc.com found a rather nasty data dependant
261   # bug whereby hash iterators could lose hash keys (and values, as the code
262   # is common) for restricted hashes.
263
264   my @keys = qw(small medium large);
265
266   # There should be no difference whether it is restricted or not
267   foreach my $lock (0, 1) {
268     # Try setting all combinations of the 3 keys
269     foreach my $usekeys (0..7) {
270       my @usekeys;
271       for my $bits (0,1,2) {
272         push @usekeys, $keys[$bits] if $usekeys & (1 << $bits);
273       }
274       my %clean = map {$_ => length $_} @usekeys;
275       my %target;
276       lock_keys ( %target, @keys ) if $lock;
277
278       while (my ($k, $v) = each %clean) {
279         $target{$k} = $v;
280       }
281
282       my $message
283         = ($lock ? 'locked' : 'not locked') . ' keys ' . join ',', @usekeys;
284
285       is (scalar keys %target, scalar keys %clean, "scalar keys for $message");
286       is (scalar values %target, scalar values %clean,
287           "scalar values for $message");
288       # Yes. All these sorts are necessary. Even for "identical hashes"
289       # Because the data dependency of the test involves two of the strings
290       # colliding on the same bucket, so the iterator order (output of keys,
291       # values, each) depends on the addition order in the hash. And locking
292       # the keys of the hash involves behind the scenes key additions.
293       is_deeply( [sort keys %target] , [sort keys %clean],
294                  "list keys for $message");
295       is_deeply( [sort values %target] , [sort values %clean],
296                  "list values for $message");
297
298       is_deeply( [sort %target] , [sort %clean],
299                  "hash in list context for $message");
300
301       my (@clean, @target);
302       while (my ($k, $v) = each %clean) {
303         push @clean, $k, $v;
304       }
305       while (my ($k, $v) = each %target) {
306         push @target, $k, $v;
307       }
308
309       is_deeply( [sort @target] , [sort @clean],
310                  "iterating with each for $message");
311     }
312   }
313 }
314
315 # Check clear works on locked empty hashes - SEGVs on 5.8.2.
316 {
317     my %hash;
318     lock_hash(%hash);
319     %hash = ();
320     ok(keys(%hash) == 0, 'clear empty lock_hash() hash');
321 }
322 {
323     my %hash;
324     lock_keys(%hash);
325     %hash = ();
326     ok(keys(%hash) == 0, 'clear empty lock_keys() hash');
327 }
328
329 my $hash_seed = hash_seed();
330 ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed");
331
332 {
333     package Minder;
334     my $counter;
335     sub DESTROY {
336         --$counter;
337     }
338     sub new {
339         ++$counter;
340         bless [], __PACKAGE__;
341     }
342     package main;
343
344     for my $state ('', 'locked') {
345         my $a = Minder->new();
346         is ($counter, 1, "There is 1 object $state");
347         my %hash;
348         $hash{a} = $a;
349         is ($counter, 1, "There is still 1 object $state");
350
351         lock_keys(%hash) if $state;
352
353         is ($counter, 1, "There is still 1 object $state");
354         undef $a;
355         is ($counter, 1, "Still 1 object $state");
356         delete $hash{a};
357         is ($counter, 0, "0 objects when hash key is deleted $state");
358         $hash{a} = undef;
359         is ($counter, 0, "Still 0 objects $state");
360         %hash = ();
361         is ($counter, 0, "0 objects after clear $state");
362     }
363 }
364 {
365     my %hash = map {$_,$_} qw(fwiffffff foosht teeoo);
366     lock_keys(%hash);
367     delete $hash{fwiffffff};
368     is (scalar keys %hash, 2,"Count of keys after delete on locked hash");
369     unlock_keys(%hash);
370     is (scalar keys %hash, 2,"Count of keys after unlock");
371
372     my ($first, $value) = each %hash;
373     is ($hash{$first}, $value, "Key has the expected value before the lock");
374     lock_keys(%hash);
375     is ($hash{$first}, $value, "Key has the expected value after the lock");
376
377     my ($second, $v2) = each %hash;
378
379     is ($hash{$first}, $value, "Still correct after iterator advances");
380     is ($hash{$second}, $v2, "Other key has the expected value");
381 }
382 {
383     my $x='foo';
384     my %test;
385     hv_store(%test,'x',$x);
386     is($test{x},'foo','hv_store() stored');
387     $test{x}='bar';
388     is($x,'bar','hv_store() aliased');
389     is($test{x},'bar','hv_store() aliased and stored');
390 }
391
392 {
393     my %hash=map { $_ => 1 } qw( a b c d e f);
394     delete $hash{c};
395     lock_keys(%hash);
396     ok(Internals::SvREADONLY(%hash),'lock_keys DDS/t 1');
397     delete @hash{qw(b e)};
398     my @hidden=sort(hidden_keys(%hash));
399     my @legal=sort(legal_keys(%hash));
400     my @keys=sort(keys(%hash));
401     #warn "@legal\n@keys\n";
402     is("@hidden","b e",'lock_keys @hidden DDS/t');
403     is("@legal","a b d e f",'lock_keys @legal DDS/t');
404     is("@keys","a d f",'lock_keys @keys DDS/t');
405 }
406 {
407     my %hash=(0..9);
408     lock_keys(%hash);
409     ok(Internals::SvREADONLY(%hash),'lock_keys DDS/t 2');
410     Hash::Util::unlock_keys(%hash);
411     ok(!Internals::SvREADONLY(%hash),'unlock_keys DDS/t 2');
412 }
413 {
414     my %hash=(0..9);
415     lock_keys(%hash,keys(%hash),'a'..'f');
416     ok(Internals::SvREADONLY(%hash),'lock_keys args DDS/t');
417     my @hidden=sort(hidden_keys(%hash));
418     my @legal=sort(legal_keys(%hash));
419     my @keys=sort(keys(%hash));
420     is("@hidden","a b c d e f",'lock_keys() @hidden DDS/t 3');
421     is("@legal","0 2 4 6 8 a b c d e f",'lock_keys() @legal DDS/t 3');
422     is("@keys","0 2 4 6 8",'lock_keys() @keys');
423 }
424 {
425     my %hash=map { $_ => 1 } qw( a b c d e f);
426     delete $hash{c};
427     lock_ref_keys(\%hash);
428     ok(Internals::SvREADONLY(%hash),'lock_ref_keys DDS/t');
429     delete @hash{qw(b e)};
430     my @hidden=sort(hidden_keys(%hash));
431     my @legal=sort(legal_keys(%hash));
432     my @keys=sort(keys(%hash));
433     #warn "@legal\n@keys\n";
434     is("@hidden","b e",'lock_ref_keys @hidden DDS/t 1');
435     is("@legal","a b d e f",'lock_ref_keys @legal DDS/t 1');
436     is("@keys","a d f",'lock_ref_keys @keys DDS/t 1');
437 }
438 {
439     my %hash=(0..9);
440     lock_ref_keys(\%hash,keys %hash,'a'..'f');
441     ok(Internals::SvREADONLY(%hash),'lock_ref_keys args DDS/t');
442     my @hidden=sort(hidden_keys(%hash));
443     my @legal=sort(legal_keys(%hash));
444     my @keys=sort(keys(%hash));
445     is("@hidden","a b c d e f",'lock_ref_keys() @hidden DDS/t 2');
446     is("@legal","0 2 4 6 8 a b c d e f",'lock_ref_keys() @legal DDS/t 2');
447     is("@keys","0 2 4 6 8",'lock_ref_keys() @keys DDS/t 2');
448 }
449 {
450     my %hash=(0..9);
451     lock_ref_keys_plus(\%hash,'a'..'f');
452     ok(Internals::SvREADONLY(%hash),'lock_ref_keys_plus args DDS/t');
453     my @hidden=sort(hidden_keys(%hash));
454     my @legal=sort(legal_keys(%hash));
455     my @keys=sort(keys(%hash));
456     is("@hidden","a b c d e f",'lock_ref_keys_plus() @hidden DDS/t');
457     is("@legal","0 2 4 6 8 a b c d e f",'lock_ref_keys_plus() @legal DDS/t');
458     is("@keys","0 2 4 6 8",'lock_ref_keys_plus() @keys DDS/t');
459 }
460 {
461     my %hash=(0..9, 'a' => 'alpha');
462     lock_ref_keys_plus(\%hash,'a'..'f');
463     ok(Internals::SvREADONLY(%hash),'lock_ref_keys_plus args overlap');
464     my @hidden=sort(hidden_keys(%hash));
465     my @legal=sort(legal_keys(%hash));
466     my @keys=sort(keys(%hash));
467     is("@hidden","b c d e f",'lock_ref_keys_plus() @hidden overlap');
468     is("@legal","0 2 4 6 8 a b c d e f",'lock_ref_keys_plus() @legal overlap');
469     is("@keys","0 2 4 6 8 a",'lock_ref_keys_plus() @keys overlap');
470 }
471 {
472     my %hash=(0..9);
473     lock_keys_plus(%hash,'a'..'f');
474     ok(Internals::SvREADONLY(%hash),'lock_keys_plus args DDS/t');
475     my @hidden=sort(hidden_keys(%hash));
476     my @legal=sort(legal_keys(%hash));
477     my @keys=sort(keys(%hash));
478     is("@hidden","a b c d e f",'lock_keys_plus() @hidden DDS/t 3');
479     is("@legal","0 2 4 6 8 a b c d e f",'lock_keys_plus() @legal DDS/t 3');
480     is("@keys","0 2 4 6 8",'lock_keys_plus() @keys DDS/t 3');
481 }
482 {
483     my %hash=(0..9, 'a' => 'alpha');
484     lock_keys_plus(%hash,'a'..'f');
485     ok(Internals::SvREADONLY(%hash),'lock_keys_plus args overlap non-ref');
486     my @hidden=sort(hidden_keys(%hash));
487     my @legal=sort(legal_keys(%hash));
488     my @keys=sort(keys(%hash));
489     is("@hidden","b c d e f",'lock_keys_plus() @hidden overlap non-ref');
490     is("@legal","0 2 4 6 8 a b c d e f",'lock_keys_plus() @legal overlap non-ref');
491     is("@keys","0 2 4 6 8 a",'lock_keys_plus() @keys overlap non-ref');
492 }
493
494 {
495     my %hash = ('a'..'f');
496     my @keys = ();
497     my @ph = ();
498     my @lock = ('a', 'c', 'e', 'g');
499     lock_keys(%hash, @lock);
500     my $ref = all_keys(%hash, @keys, @ph);
501     my @crrack = sort(@keys);
502     my @ooooff = qw(a c e);
503     my @bam = qw(g);
504
505     ok(ref $ref eq ref \%hash && $ref == \%hash, 
506             "all_keys() - \$ref is a reference to \%hash");
507     is_deeply(\@crrack, \@ooooff, "Keys are what they should be");
508     is_deeply(\@ph, \@bam, "Placeholders in place");
509 }
510
511 {
512     my %hash = (
513         a   => 'alpha',
514         b   => [ qw( beta gamma delta ) ],
515         c   => [ 'epsilon', { zeta => 'eta' }, ],
516         d   => { theta => 'iota' },
517     );
518     lock_hash_recurse(%hash);
519     ok( hash_locked(%hash),
520         "lock_hash_recurse(): top-level hash locked" );
521     ok( hash_locked(%{$hash{d}}),
522         "lock_hash_recurse(): element which is hashref locked" );
523     ok( ! hash_locked(%{$hash{c}[1]}),
524         "lock_hash_recurse(): element which is hashref in array ref not locked" );
525
526     unlock_hash_recurse(%hash);
527     ok( hash_unlocked(%hash),
528         "unlock_hash_recurse(): top-level hash unlocked" );
529     ok( hash_unlocked(%{$hash{d}}),
530         "unlock_hash_recurse(): element which is hashref unlocked" );
531     ok( hash_unlocked(%{$hash{c}[1]}),
532         "unlock_hash_recurse(): element which is hashref in array ref not locked" );
533 }
534
535 {
536     my $h1= hash_value("foo");
537     my $h2= hash_value("bar");
538     is( $h1, hash_value("foo") );
539     is( $h2, hash_value("bar") );
540 }
541 {
542     my @info1= bucket_info({});
543     my @info2= bucket_info({1..10});
544     my @stats1= bucket_stats({});
545     my @stats2= bucket_stats({1..10});
546     my $array1= bucket_array({});
547     my $array2= bucket_array({1..10});
548     is("@info1","0 8 0");
549     is("@info2[0,1]","5 8");
550     is("@stats1","0 8 0");
551     is("@stats2[0,1]","5 8");
552     my @keys1= sort map { ref $_ ? @$_ : () } @$array1;
553     my @keys2= sort map { ref $_ ? @$_ : () } @$array2;
554     is("@keys1","");
555     is("@keys2","1 3 5 7 9");
556 }