summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-05-19 16:54:01 -0700
committerFather Chrysostomos <sprout@cpan.org>2011-05-19 17:09:47 -0700
commit348990471457e062920a311769ddae09a49fa203 (patch)
treeee5106da1714a79897bdb022a4278ccdf4d6d86d
parentae19993915a27e9fb5ee79b7a2624dba0bd876cd (diff)
downloadperl-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--MANIFEST1
-rw-r--r--t/op/hash-rt85026.t67
2 files changed, 68 insertions, 0 deletions
diff --git a/MANIFEST b/MANIFEST
index 7aefe0ecba..b1395489c4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -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!");