Allow COW values to be deleted from restricted hashes

I wonder how many other things a604c75 broke....

diff --git a/dist/base/t/fields.t b/dist/base/t/fields.t
index 4999cfe..a3493ce 100644 (file)
--- a/dist/base/t/fields.t
+++ b/dist/base/t/fields.t
@@ -6,7 +6,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 16;
+use Test::More tests => 17;
 
 BEGIN { use_ok('fields'); }
 
@@ -106,4 +106,10 @@ package main;
     is(ref $x, 'Test::FooBar', 'x is a Test::FooBar');
     ok(exists $x->{a}, 'x has a');
     ok(exists $x->{b}, 'x has b');
+
+    SKIP: {
+        skip "This test triggers a perl bug", 1 if $] < 5.014001;
+        $x->{a} = __PACKAGE__;
+        ok eval { delete $x->{a}; 1 }, 'deleting COW values';
+    }
 }

diff --git a/hv.c b/hv.c
index aa1783e..01ecf39 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1003,7 +1003,8 @@ 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))) {
+       if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))
+        && !SvIsCOW(HeVAL(entry))) {
            hv_notallowed(k_flags, key, klen,
                            "Attempt to delete readonly key '%"SVf"' from"
                            " a restricted hash");