Perl_refcounted_he_chain_2hv()'s code to skip duplicate keys was far

too lax.

p4raw-id: //depot/perl@28320

diff --git a/hv.c b/hv.c
index 04439fa..750988c 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -2634,7 +2634,26 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
 
        for (; entry; entry = HeNEXT(entry)) {
            if (HeHASH(entry) == hash) {
-               goto next_please;
+               /* We might have a duplicate key here.  If so, entry is older
+                  than the key we've already put in the hash, so if they are
+                  the same, skip adding entry.  */
+#ifdef USE_ITHREADS
+               const STRLEN klen = HeKLEN(entry);
+               const char *const key = HeKEY(entry);
+               if (klen == chain->refcounted_he_keylen
+                   && (!!HeKUTF8(entry)
+                       == !!(chain->refcounted_he_data[0] & HVhek_UTF8))
+                   && memEQ(key, REF_HE_KEY(chain), klen))
+                   goto next_please;
+#else
+               if (HeKEY_hek(entry) == chain->refcounted_he_hek)
+                   goto next_please;
+               if (HeKLEN(entry) == HEK_LEN(chain->refcounted_he_hek)
+                   && HeKUTF8(entry) == HEK_UTF8(chain->refcounted_he_hek)
+                   && memEQ(HeKEY(entry), HEK_KEY(chain->refcounted_he_hek),
+                            HeKLEN(entry)))
+                   goto next_please;
+#endif
            }
        }
        assert (!entry);

diff --git a/t/op/caller.t b/t/op/caller.t
index d0716be..c5bb84e 100644 (file)
--- a/t/op/caller.t
+++ b/t/op/caller.t
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan( tests => 71 );
+    plan( tests => 77 );
 }
 
 my @c;
@@ -267,3 +267,27 @@ EOE
     is(get_hash()->{$k2}, 2, "UTF-8 or not, it's the same");
     is(get_hash()->{$k3}, 3, "Octect sequences and UTF-8 are distinct");
 }
+
+{
+    my ($k1, $k2, $k3);
+    BEGIN {
+       ($k1, $k2, $k3) = ("\0", "\0\0", "\0\0\0");
+       $^H{$k1} = 1;
+       $^H{$k2} = 2;
+       $^H{$k3} = 3;
+    }
+
+    is(get_hash()->{$k1}, 1, "Keys with the same hash value don't clash");
+    is(get_hash()->{$k2}, 2, "Keys with the same hash value don't clash");
+    is(get_hash()->{$k3}, 3, "Keys with the same hash value don't clash");
+
+    BEGIN {
+       $^H{$k1} = "a";
+       $^H{$k2} = "b";
+       $^H{$k3} = "c";
+    }
+
+    is(get_hash()->{$k1}, "a", "Keys with the same hash value don't clash");
+    is(get_hash()->{$k2}, "b", "Keys with the same hash value don't clash");
+    is(get_hash()->{$k3}, "c", "Keys with the same hash value don't clash");
+}