This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use set_up_inc for several unit tests
[perl5.git] / t / op / hash-rt85026.t
CommitLineData
34899047
FC
1#!/usr/bin/perl -w
2
3BEGIN {
a817e89d 4 chdir 't' if -d 't';
34899047 5 require './test.pl';
624c42e2 6 set_up_inc( '../lib' );
34899047
FC
7}
8
624c42e2
N
9skip_all_without_dynamic_extension("Devel::Peek");
10
11
34899047
FC
12use strict;
13use Devel::Peek;
14use File::Temp qw(tempdir);
3df5101b 15use File::Spec;
34899047
FC
16
17my %hash = map +($_ => 1), ("a".."z");
18
19my $tmp_dir = tempdir(CLEANUP => 1);
3df5101b 20my $tmp_file = File::Spec->catfile($tmp_dir, 'dump');
34899047
FC
21
22sub 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
38my @riters;
39while (my $key = each %hash) {
40 push @{$riters[riter()]}, $key;
41}
42
43my ($first_key, $second_key);
44my $riter = 0;
45for 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
57plan(1);
58
59# Ok all preparation is done
369fb445 60note <<"EOF"
34899047
FC
61Found keys '$first_key' and '$second_key' on chain $riter
62Will now iterato to key '$first_key' then delete '$first_key' and '$second_key'.
63EOF
64;
651 until $first_key eq each %hash;
66delete $hash{$first_key};
67delete $hash{$second_key};
68
369fb445 69note "Now iterating into freed memory\n";
34899047
FC
701 for each %hash;
71ok(1, "Survived!");