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