blob: 91087b806f6bd80a7d2d5f8ae4fe7381aaf33e35 (
plain)
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
|
#!/usr/bin/perl -w
BEGIN {
chdir 't';
@INC = '../lib';
require './test.pl';
skip_all_without_dynamic_extension("Devel::Peek");
}
use strict;
use Devel::Peek;
use File::Temp qw(tempdir);
use File::Spec;
my %hash = map +($_ => 1), ("a".."z");
my $tmp_dir = tempdir(CLEANUP => 1);
my $tmp_file = File::Spec->catfile($tmp_dir, 'dump');
sub riter {
local *OLDERR;
open(OLDERR, ">&STDERR") || die "Can't dup STDERR: $!";
open(STDERR, ">", $tmp_file) ||
die "Could not open '$tmp_file' for write: $^E";
Dump(\%hash);
open(STDERR, ">&OLDERR") || die "Can't dup OLDERR: $!";
open(my $fh, "<", $tmp_file) ||
die "Could not open '$tmp_file' for read: $^E";
local $/;
my $dump = <$fh>;
my ($riter) = $dump =~ /^\s*RITER\s*=\s*(\d+)/m or
die "No plain RITER in dump '$dump'";
return $riter;
}
my @riters;
while (my $key = each %hash) {
push @{$riters[riter()]}, $key;
}
my ($first_key, $second_key);
my $riter = 0;
for my $chain (@riters) {
if ($chain && @$chain >= 2) {
$first_key = $chain->[0];
$second_key = $chain->[1];
last;
}
$riter++;
}
$first_key ||
skip_all "No 2 element chains; need a different initial HASH";
$| = 1;
plan(1);
# Ok all preparation is done
note <<"EOF"
Found keys '$first_key' and '$second_key' on chain $riter
Will now iterato to key '$first_key' then delete '$first_key' and '$second_key'.
EOF
;
1 until $first_key eq each %hash;
delete $hash{$first_key};
delete $hash{$second_key};
note "Now iterating into freed memory\n";
1 for each %hash;
ok(1, "Survived!");
|
