1#!/usr/bin/perl -w 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc( '../lib' ); 7 skip_all_without_dynamic_extension("Devel::Peek"); 8} 9 10use strict; 11use Devel::Peek; 12use File::Temp qw(tempdir); 13use File::Spec; 14 15my %hash = map +($_ => 1), ("a".."z"); 16 17my $tmp_dir = tempdir(CLEANUP => 1); 18my $tmp_file = File::Spec->catfile($tmp_dir, 'dump'); 19 20sub riter { 21 local *OLDERR; 22 open(OLDERR, ">&STDERR") || die "Can't dup STDERR: $!"; 23 open(STDERR, ">", $tmp_file) || 24 die "Could not open '$tmp_file' for write: $^E"; 25 Dump(\%hash); 26 open(STDERR, ">&OLDERR") || die "Can't dup OLDERR: $!"; 27 open(my $fh, "<", $tmp_file) || 28 die "Could not open '$tmp_file' for read: $^E"; 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 36my @riters; 37while (my $key = each %hash) { 38 push @{$riters[riter()]}, $key; 39} 40 41my ($first_key, $second_key); 42my $riter = 0; 43for 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 55plan(1); 56 57# Ok all preparation is done 58note <<"EOF" 59Found keys '$first_key' and '$second_key' on chain $riter 60Will now iterato to key '$first_key' then delete '$first_key' and '$second_key'. 61EOF 62; 631 until $first_key eq each %hash; 64delete $hash{$first_key}; 65delete $hash{$second_key}; 66 67note "Now iterating into freed memory\n"; 681 for each %hash; 69ok(1, "Survived!"); 70