diff options
author | Nicholas Clark <nick@ccl4.org> | 2021-10-16 18:06:44 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2021-10-20 15:34:23 +0000 |
commit | 33042aafe7427f88db58e555390c82dd25ef9a28 (patch) | |
tree | 56a3df0e0d6d3d27ccdabb89941863b1d942003b | |
parent | 7c4cc0343c223680358a798ea6826c8c3a710db3 (diff) | |
download | perl-33042aafe7427f88db58e555390c82dd25ef9a28.tar.gz |
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.
-rw-r--r-- | ext/Devel-Peek/t/Peek.t | 5 | ||||
-rw-r--r-- | ext/XS-APItest/APItest.xs | 4 | ||||
-rw-r--r-- | hv.c | 21 | ||||
-rw-r--r-- | 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); @@ -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; @@ -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//; |