Hash Function Change - Murmur hash and true per process hash seed
[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 => 10;
12
13 # This will crash perl if it fails
14
15 use constant PVBM => 'foo';
16
17 my $dummy = index 'foo', PVBM;
18 eval { my %h = (a => PVBM); 1 };
19
20 ok (!$@, 'fbm scalar can be inserted into a hash');
21
22
23 my $destroyed;
24 { package Class; DESTROY { ++$destroyed; } }
25
26 $destroyed = 0;
27 {
28     my %h;
29     keys(%h) = 1;
30     $h{key} = bless({}, 'Class');
31 }
32 is($destroyed, 1, 'Timely hash destruction with lvalue keys');
33
34
35 # [perl #79178] Hash keys must not be stringified during compilation
36 # Run perl -MO=Concise -e '$a{\"foo"}' on a non-threaded pre-5.13.8 version
37 # to see why.
38 {
39     my $key;
40     package bar;
41     sub TIEHASH { bless {}, $_[0] }
42     sub FETCH { $key = $_[1] }
43     package main;
44     tie my %h, "bar";
45     () = $h{\'foo'};
46     is ref $key, SCALAR =>
47      'hash keys are not stringified during compilation';
48 }
49
50 # Part of RT #85026: Deleting the current iterator in void context does not
51 # free it.
52 {
53     my $gone;
54     no warnings 'once';
55     local *::DESTROY = sub { ++$gone };
56     my %a=(a=>bless[]);
57     each %a;   # make the entry with the obj the current iterator
58     delete $a{a};
59     ok $gone, 'deleting the current iterator in void context frees the val'
60 }
61
62 # [perl #99660] Deleted hash element visible to destructor
63 {
64     my %h;
65     $h{k} = bless [];
66     my $normal_exit;
67     local *::DESTROY = sub { my $x = $h{k}; ++$normal_exit };
68     delete $h{k}; # must be in void context to trigger the bug
69     ok $normal_exit, 'freed hash elems are not visible to DESTROY';
70 }
71
72 # [perl #100340] Similar bug: freeing a hash elem during a delete
73 sub guard::DESTROY {
74    ${$_[0]}->();
75 };
76 *guard = sub (&) {
77    my $callback = shift;
78    return bless \$callback, "guard"
79 };
80 {
81   my $ok;
82   my %t; %t = (
83     stash => {
84         guard => guard(sub{
85             $ok++;
86             delete $t{stash};
87         }),
88         foo => "bar",
89         bar => "baz",
90     },
91   );
92   ok eval { delete $t{stash}{guard}; # must be in void context
93             1 },
94     'freeing a hash elem from destructor called by delete does not die';
95   diag $@ if $@; # panic: free from wrong pool
96   is $ok, 1, 'the destructor was called';
97 }
98
99 # Weak references to pad hashes
100 SKIP: {
101     skip_if_miniperl("No Scalar::Util::weaken under miniperl", 1);
102     my $ref;
103     require Scalar::Util;
104     {
105         my %hash;
106         Scalar::Util::weaken($ref = \%hash);
107         1;  # the previous statement must not be the last
108     }
109     is $ref, undef, 'weak refs to pad hashes go stale on scope exit';
110 }
111
112 # [perl #107440]
113 sub A::DESTROY { $::ra = 0 }
114 $::ra = {a=>bless [], 'A'};
115 undef %$::ra;
116 pass 'no crash when freeing hash that is being undeffed';
117 $::ra = {a=>bless [], 'A'};
118 %$::ra = ('a'..'z');
119 pass 'no crash when freeing hash that is being exonerated, ahem, cleared';