Change 18259 by rgs@rgs-home on 2002/12/08 19:34:34
Subject: [PATCH] Re: [perl #18651] Hash::Util's lock_key() breaks hash
From: Nicholas Clark <[EMAIL PROTECTED]>
Date: Mon, 2 Dec 2002 21:48:29 +0000
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/hv.c#119 edit
.... //depot/perl/lib/Hash/Util.t#5 edit
Differences ...
==== //depot/perl/hv.c#119 (text) ====
Index: perl/hv.c
--- perl/hv.c#118~17740~ Tue Aug 20 07:07:56 2002
+++ perl/hv.c Sun Dec 8 11:34:34 2002
@@ -1855,6 +1855,7 @@
Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
char);
+ /* At start of hash, entry is NULL. */
if (entry)
{
entry = HeNEXT(entry);
@@ -1869,8 +1870,11 @@
}
}
while (!entry) {
+ /* OK. Come to the end of the current list. Grab the next one. */
+
xhv->xhv_riter++; /* HvRITER(hv)++ */
if (xhv->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
+ /* There is no next one. End of the hash. */
xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
break;
}
@@ -1878,10 +1882,14 @@
entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
- /* if we have an entry, but it's a placeholder, don't count it */
- if (entry && HeVAL(entry) == &PL_sv_undef)
- entry = 0;
- }
+ /* If we have an entry, but it's a placeholder, don't count it.
+ Try the next. */
+ while (entry && HeVAL(entry) == &PL_sv_undef)
+ entry = HeNEXT(entry);
+ }
+ /* Will loop again if this linked list starts NULL
+ (for HV_ITERNEXT_WANTPLACEHOLDERS)
+ or if we run through it and find only placeholders. */
}
if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
==== //depot/perl/lib/Hash/Util.t#5 (text) ====
Index: perl/lib/Hash/Util.t
--- perl/lib/Hash/Util.t#4~15926~ Mon Apr 15 06:47:16 2002
+++ perl/lib/Hash/Util.t Sun Dec 8 11:34:34 2002
@@ -6,7 +6,7 @@
chdir 't';
}
}
-use Test::More tests => 61;
+use Test::More tests => 157;
use strict;
my @Exported_Funcs;
@@ -226,4 +226,60 @@
"undef values should not be misunderstood as placeholders");
is ($hash{nowt}, undef,
"undef values should not be misunderstood as placeholders (again)");
+}
+
+{
+ # perl #18651 - [EMAIL PROTECTED] found a rather nasty data dependant
+ # bug whereby hash iterators could lose hash keys (and values, as the code
+ # is common) for restricted hashes.
+
+ my @keys = qw(small medium large);
+
+ # There should be no difference whether it is restricted or not
+ foreach my $lock (0, 1) {
+ # Try setting all combinations of the 3 keys
+ foreach my $usekeys (0..7) {
+ my @usekeys;
+ for my $bits (0,1,2) {
+ push @usekeys, $keys[$bits] if $usekeys & (1 << $bits);
+ }
+ my %clean = map {$_ => length $_} @usekeys;
+ my %target;
+ lock_keys ( %target, @keys ) if $lock;
+
+ while (my ($k, $v) = each %clean) {
+ $target{$k} = $v;
+ }
+
+ my $message
+ = ($lock ? 'locked' : 'not locked') . ' keys ' . join ',', @usekeys;
+
+ is (scalar keys %target, scalar keys %clean, "scalar keys for $message");
+ is (scalar values %target, scalar values %clean,
+ "scalar values for $message");
+ # Yes. All these sorts are necessary. Even for "identical hashes"
+ # Because the data dependency of the test involves two of the strings
+ # colliding on the same bucket, so the iterator order (output of keys,
+ # values, each) depends on the addition order in the hash. And locking
+ # the keys of the hash involves behind the scenes key additions.
+ is_deeply( [sort keys %target] , [sort keys %clean],
+ "list keys for $message");
+ is_deeply( [sort values %target] , [sort values %clean],
+ "list values for $message");
+
+ is_deeply( [sort %target] , [sort %clean],
+ "hash in list context for $message");
+
+ my (@clean, @target);
+ while (my ($k, $v) = each %clean) {
+ push @clean, $k, $v;
+ }
+ while (my ($k, $v) = each %target) {
+ push @target, $k, $v;
+ }
+
+ is_deeply( [sort @target] , [sort @clean],
+ "iterating with each for $message");
+ }
+ }
}
End of Patch.
