From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 2 Dec 2002 21:48:29 +0000 (+0000)
Subject: Re: [perl #18651] Hash::Util's lock_key() breaks hash
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=015a5f36be663aa2533aa485ced211ebada3b063;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #18651] Hash::Util's lock_key() breaks hash
Message-ID: <20021202214828.GA284@Bagpuss.unfortu.net>

p4raw-id: //depot/perl@18259
---

diff --git a/hv.c b/hv.c
index 0d08767..7b79123 100644
--- a/hv.c
+++ b/hv.c
@@ -1855,6 +1855,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
 	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 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
 	}
     }
     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 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
 	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? */
diff --git a/lib/Hash/Util.t b/lib/Hash/Util.t
index 20efb44..248fa8e 100644
--- a/lib/Hash/Util.t
+++ b/lib/Hash/Util.t
@@ -6,7 +6,7 @@ BEGIN {
         chdir 't';
     }
 }
-use Test::More tests => 61;
+use Test::More tests => 157;
 use strict;
 
 my @Exported_Funcs;
@@ -227,3 +227,59 @@ like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted ha
     is ($hash{nowt}, undef,
         "undef values should not be misunderstood as placeholders (again)");
 }
+
+{
+  # perl #18651 - tim@consultix-inc.com 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");
+    }
+  }
+}