From 33042aafe7427f88db58e555390c82dd25ef9a28 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 16 Oct 2021 18:06:44 +0000
Subject: Fix the build and tests when NODEFAULT_SHAREKEYS is defined

Defining this macro causes newHV() to create hashes without shared hash key
scalars. The default is that hashes are created with shared hash keys.
---
 ext/Devel-Peek/t/Peek.t   |  5 +++++
 ext/XS-APItest/APItest.xs |  4 ++++
 hv.c                      | 21 +++++++++++++++++++--
 t/op/tr.t                 |  6 +++++-
 4 files changed, 33 insertions(+), 3 deletions(-)

diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index 63face8cd1..8c2f113c59 100644
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -98,6 +98,11 @@ sub do_test {
 		if $Config{ccflags} =~
 			/-DPERL_(?:OLD_COPY_ON_WRITE|NO_COW)\b/
 			    || $] < 5.019003;
+            if ($Config::Config{ccflags} =~ /-DNODEFAULT_SHAREKEYS\b/) {
+                $pattern =~ s/,SHAREKEYS\b//g;
+                $pattern =~ s/\bSHAREKEYS,//g;
+                $pattern =~ s/\bSHAREKEYS\b//g;
+            }
 	    print $pattern, "\n" if $DEBUG;
 	    my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>;
 	    print $dump, "\n"    if $DEBUG;
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 2b5aeee5fa..f0a2ca3921 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -208,6 +208,10 @@ test_freeent(freeent_function *f) {
     PL_body_roots[HE_ARENA_ROOT_IX] = HeNEXT(victim);
 #endif
 
+#ifdef NODEFAULT_SHAREKEYS
+    HvSHAREKEYS_on(test_hash);
+#endif
+
     victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
 
     test_scalar = newSV(0);
diff --git a/hv.c b/hv.c
index 06fe493f3f..c9f2ef89d6 100644
--- a/hv.c
+++ b/hv.c
@@ -640,6 +640,9 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
         PERL_HASH(hash, key, klen);
 
     masked_flags = (flags & HVhek_MASK);
+    if (!HvSHAREKEYS(hv)) {
+        masked_flags |= HVhek_UNSHARED;
+    }
 
 #ifdef DYNAMIC_ENV_FETCH
     if (!HvARRAY(hv)) entry = NULL;
@@ -1594,8 +1597,12 @@ Perl_newHVhv(pTHX_ HV *ohv)
         ents = (HE**)a;
 
         if (shared) {
+#ifdef NODEFAULT_SHAREKEYS
+            HvSHAREKEYS_on(hv);
+#else
             /* Shared is the default - it should have been set by newHV(). */
             assert(HvSHAREKEYS(hv));
+#endif
         }
         else {
             HvSHAREKEYS_off(hv);
@@ -1732,10 +1739,14 @@ S_hv_free_ent_ret(pTHX_ HV *hv, HE *entry)
         SvREFCNT_dec(HeKEY_sv(entry));
         Safefree(HeKEY_hek(entry));
     }
-    else if (HvSHAREKEYS(hv))
+    else if (HvSHAREKEYS(hv)) {
+        assert((HEK_FLAGS(HeKEY_hek(entry)) & HVhek_UNSHARED) == 0);
         unshare_hek(HeKEY_hek(entry));
-    else
+    }
+    else {
+        assert((HEK_FLAGS(HeKEY_hek(entry)) & HVhek_UNSHARED) == HVhek_UNSHARED);
         Safefree(HeKEY_hek(entry));
+    }
     del_HE(entry);
     return val;
 }
@@ -2918,6 +2929,7 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
     struct shared_he *he = NULL;
 
     if (hek) {
+        assert((HEK_FLAGS(hek) & HVhek_UNSHARED) == 0);
         /* Find the shared he which is just before us in memory.  */
         he = (struct shared_he *)(((char *)hek)
                                   - STRUCT_OFFSET(struct shared_he,
@@ -3224,6 +3236,11 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags)
        and call ksplit.  But for now we'll make a potentially inefficient
        hash with only 8 entries in its array.  */
     hv = newHV();
+#ifdef NODEFAULT_SHAREKEYS
+    /* We share keys in the COP, so it's much easier to keep sharing keys in
+       the hash we build from it. */
+    HvSHAREKEYS_on(hv);
+#endif
     max = HvMAX(hv);
     if (!HvARRAY(hv)) {
         char *array;
diff --git a/t/op/tr.t b/t/op/tr.t
index cabcac65ac..f2bef94dfa 100644
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -12,6 +12,7 @@ BEGIN {
 }
 
 use utf8;
+require Config;
 
 plan tests => 315;
 
@@ -1032,9 +1033,12 @@ is($s, "AxBC", "utf8, DELETE");
     is($c, "\x20\x30\x40\x50\x60", "tr/\\x00-\\x1f//d");
 }
 
-($s) = keys %{{pie => 3}};
 SKIP: {
     if (!eval { require XS::APItest }) { skip "no XS::APItest", 2 }
+    skip "with NODEFAULT_SHAREKEYS there are few COWs", 2
+        if $Config::Config{ccflags} =~ /-DNODEFAULT_SHAREKEYS\b/;
+
+    ($s) = keys %{{pie => 3}};
     my $wasro = XS::APItest::SvIsCOW($s);
     ok $wasro, "have a COW";
     $s =~ tr/i//;
-- 
cgit v1.2.1