Commit | Line | Data |
---|---|---|
34899047 FC |
1 | #!/usr/bin/perl -w |
2 | ||
3 | BEGIN { | |
4 | chdir 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | skip_all_without_dynamic_extension("Devel::Peek"); | |
8 | } | |
9 | ||
10 | use strict; | |
11 | use Devel::Peek; | |
12 | use File::Temp qw(tempdir); | |
3df5101b | 13 | use File::Spec; |
34899047 FC |
14 | |
15 | my %hash = map +($_ => 1), ("a".."z"); | |
16 | ||
17 | my $tmp_dir = tempdir(CLEANUP => 1); | |
3df5101b | 18 | my $tmp_file = File::Spec->catfile($tmp_dir, 'dump'); |
34899047 FC |
19 | |
20 | sub riter { | |
21 | local *OLDERR; | |
22 | open(OLDERR, ">&STDERR") || die "Can't dup STDERR: $!"; | |
3df5101b CB |
23 | open(STDERR, ">", $tmp_file) || |
24 | die "Could not open '$tmp_file' for write: $^E"; | |
34899047 FC |
25 | Dump(\%hash); |
26 | open(STDERR, ">&OLDERR") || die "Can't dup OLDERR: $!"; | |
3df5101b CB |
27 | open(my $fh, "<", $tmp_file) || |
28 | die "Could not open '$tmp_file' for read: $^E"; | |
34899047 FC |
29 | local $/; |
30 | my $dump = <$fh>; | |
31 | my ($riter) = $dump =~ /^\s*RITER\s*=\s*(\d+)/m or | |
32 | die "No plain RITER in dump '$dump'"; | |
33 | return $riter; | |
34 | } | |
35 | ||
36 | my @riters; | |
37 | while (my $key = each %hash) { | |
38 | push @{$riters[riter()]}, $key; | |
39 | } | |
40 | ||
41 | my ($first_key, $second_key); | |
42 | my $riter = 0; | |
43 | for my $chain (@riters) { | |
44 | if ($chain && @$chain >= 2) { | |
45 | $first_key = $chain->[0]; | |
46 | $second_key = $chain->[1]; | |
47 | last; | |
48 | } | |
49 | $riter++; | |
50 | } | |
51 | $first_key || | |
52 | skip_all "No 2 element chains; need a different initial HASH"; | |
53 | $| = 1; | |
54 | ||
55 | plan(1); | |
56 | ||
57 | # Ok all preparation is done | |
369fb445 | 58 | note <<"EOF" |
34899047 FC |
59 | Found keys '$first_key' and '$second_key' on chain $riter |
60 | Will now iterato to key '$first_key' then delete '$first_key' and '$second_key'. | |
61 | EOF | |
62 | ; | |
63 | 1 until $first_key eq each %hash; | |
64 | delete $hash{$first_key}; | |
65 | delete $hash{$second_key}; | |
66 | ||
369fb445 | 67 | note "Now iterating into freed memory\n"; |
34899047 FC |
68 | 1 for each %hash; |
69 | ok(1, "Survived!"); |