From fb2352ebbcdd380053ad8408a0613965b0ec2950 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sat, 4 Jun 2011 11:58:14 -0700 Subject: [PATCH] Allow restricted hashes containing COWs to be cleared --- dist/base/t/fields.t | 6 ++++-- hv.c | 3 ++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/dist/base/t/fields.t b/dist/base/t/fields.t index a3493ce..d5f23b6 100644 --- 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 --- 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", -- 2.7.4