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