Don’t treat COWs specially in locked hashes

This is left over from when READONLY+FAKE meant copy-on-write.

Read-only copy-on-write scalars (which could not occur with the old
way of flagging things) must not be exempt from hash key restrictions.

diff --git a/ext/Hash-Util/t/Util.t b/ext/Hash-Util/t/Util.t
index 63769b8..2e9e333 100644 (file)
--- a/ext/Hash-Util/t/Util.t
+++ b/ext/Hash-Util/t/Util.t
@@ -37,7 +37,7 @@ BEGIN {
                      hv_store
                      lock_hash_recurse unlock_hash_recurse
                     );
-    plan tests => 234 + @Exported_Funcs;
+    plan tests => 236 + @Exported_Funcs;
     use_ok 'Hash::Util', @Exported_Funcs;
 }
 foreach my $func (@Exported_Funcs) {
@@ -197,6 +197,7 @@ like(
     qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/,
     'locked %ENV'
 );
+unlock_keys(%ENV); # Test::Builder cannot print test failures otherwise
 
 {
     my %hash;
@@ -326,6 +327,18 @@ like(
     ok(keys(%hash) == 0, 'clear empty lock_keys() hash');
 }
 
+# Copy-on-write scalars should not be deletable after lock_hash;
+{
+    my %hash = (key=>__PACKAGE__);
+    lock_hash(%hash);
+    eval { delete $hash{key} };
+    like $@, qr/^Attempt to delete readonly key /,
+        'COW scalars are not exempt from lock_hash (delete)';
+    eval { %hash = () };
+    like $@, qr/^Attempt to delete readonly key /,
+        'COW scalars are not exempt from lock_hash (clear)';
+}
+
 my $hash_seed = hash_seed();
 ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed");
 

diff --git a/hv.c b/hv.c
index 22d5603..02fe607 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1062,8 +1062,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                Safefree(key);
            return NULL;
        }
-       if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))
-        && !SvIsCOW(HeVAL(entry))) {
+       if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
            hv_notallowed(k_flags, key, klen,
                            "Attempt to delete readonly key '%"SVf"' from"
                            " a restricted hash");
@@ -1537,7 +1536,7 @@ Perl_hv_clear(pTHX_ HV *hv)
                /* not already placeholder */
                if (HeVAL(entry) != &PL_sv_placeholder) {
                    if (HeVAL(entry)) {
-                       if (SvREADONLY(HeVAL(entry)) && !SvIsCOW(HeVAL(entry))) {
+                       if (SvREADONLY(HeVAL(entry))) {
                            SV* const keysv = hv_iterkeysv(entry);
                            Perl_croak_nocontext(
                                "Attempt to delete readonly key '%"SVf"' from a restricted hash",