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