diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-05-19 16:54:01 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-05-19 17:09:47 -0700 |
commit | 348990471457e062920a311769ddae09a49fa203 (patch) | |
tree | ee5106da1714a79897bdb022a4278ccdf4d6d86d | |
parent | ae19993915a27e9fb5ee79b7a2624dba0bd876cd (diff) | |
download | perl-348990471457e062920a311769ddae09a49fa203.tar.gz |
Tests for #85026
Almost all of this is taken verbatim from Ton Hospel’s sample script
for demonstrating the bug.
-rw-r--r-- | MANIFEST | 1 | ||||
-rw-r--r-- | t/op/hash-rt85026.t | 67 |
2 files changed, 68 insertions, 0 deletions
@@ -4892,6 +4892,7 @@ t/op/grep.t See if grep() and map() work t/op/groups.t See if $( works t/op/gv.t See if typeglobs work t/op/hashassign.t See if hash assignments work +t/op/hash-rt85026.t See if hash iteration/deletion works t/op/hash.t See if the complexity attackers are repelled t/op/hashwarn.t See if warnings for bad hash assignments work t/op/inccode.t See if coderefs work in @INC diff --git a/t/op/hash-rt85026.t b/t/op/hash-rt85026.t new file mode 100644 index 0000000000..61c0fb4c97 --- /dev/null +++ b/t/op/hash-rt85026.t @@ -0,0 +1,67 @@ +#!/usr/bin/perl -w + +BEGIN { + chdir 't'; + @INC = '../lib'; + require './test.pl'; + skip_all_without_dynamic_extension("Devel::Peek"); +} + +use strict; +use Devel::Peek; +use File::Temp qw(tempdir); + +my %hash = map +($_ => 1), ("a".."z"); + +my $tmp_dir = tempdir(CLEANUP => 1); + +sub riter { + local *OLDERR; + open(OLDERR, ">&STDERR") || die "Can't dup STDERR: $!"; + open(STDERR, ">", "$tmp_dir/dump") || + die "Could not open '$tmp_dir/dump' for write: $^E"; + Dump(\%hash); + open(STDERR, ">&OLDERR") || die "Can't dup OLDERR: $!"; + open(my $fh, "<", "$tmp_dir/dump") || + die "Could not open '$tmp_dir/dump' for read: $^E"; + local $/; + my $dump = <$fh>; + my ($riter) = $dump =~ /^\s*RITER\s*=\s*(\d+)/m or + die "No plain RITER in dump '$dump'"; + return $riter; +} + +my @riters; +while (my $key = each %hash) { + push @{$riters[riter()]}, $key; +} + +my ($first_key, $second_key); +my $riter = 0; +for my $chain (@riters) { + if ($chain && @$chain >= 2) { + $first_key = $chain->[0]; + $second_key = $chain->[1]; + last; + } + $riter++; +} +$first_key || + skip_all "No 2 element chains; need a different initial HASH"; +$| = 1; + +plan(1); + +# Ok all preparation is done +diag <<"EOF" +Found keys '$first_key' and '$second_key' on chain $riter +Will now iterato to key '$first_key' then delete '$first_key' and '$second_key'. +EOF +; +1 until $first_key eq each %hash; +delete $hash{$first_key}; +delete $hash{$second_key}; + +diag "Now iterating into freed memory\n"; +1 for each %hash; +ok(1, "Survived!"); |