This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make hash-rt85026.t less noisy
[perl5.git] / t / op / hash-rt85026.t
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);
13 use File::Spec;
14
15 my %hash = map +($_ => 1), ("a".."z");
16
17 my $tmp_dir = tempdir(CLEANUP => 1);
18 my $tmp_file = File::Spec->catfile($tmp_dir, 'dump');
19
20 sub 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
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
58 note <<"EOF"
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
67 note "Now iterating into freed memory\n";
68 1 for each %hash;
69 ok(1, "Survived!");