Allow restricted hashes containing COWs to be cleared

diff --git a/dist/base/t/fields.t b/dist/base/t/fields.t
index a3493ce..d5f23b6 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 => 17;
+use Test::More tests => 18;
 
 BEGIN { use_ok('fields'); }
 
@@ -108,8 +108,10 @@ package main;
     ok(exists $x->{b}, 'x has b');
 
     SKIP: {
-        skip "This test triggers a perl bug", 1 if $] < 5.014001;
+        skip "These tests trigger a perl bug", 1 if $] < 5.014001;
         $x->{a} = __PACKAGE__;
         ok eval { delete $x->{a}; 1 }, 'deleting COW values';
+        $x->{a} = __PACKAGE__;
+        ok eval { %$x = (); 1 }, 'clearing a restr hash containing COWs';
     }
 }

diff --git a/hv.c b/hv.c
index 01ecf39..51c782a 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1554,7 +1554,8 @@ Perl_hv_clear(pTHX_ HV *hv)
            for (; entry; entry = HeNEXT(entry)) {
                /* not already placeholder */
                if (HeVAL(entry) != &PL_sv_placeholder) {
-                   if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+                   if (HeVAL(entry) && SvREADONLY(HeVAL(entry))
+                    && !SvIsCOW(HeVAL(entry))) {
                        SV* const keysv = hv_iterkeysv(entry);
                        Perl_croak(aTHX_
                                   "Attempt to delete readonly key '%"SVf"' from a restricted hash",