diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2011-06-04 11:58:14 -0700 |
|---|---|---|
| committer | Florian Ragwitz <rafl@debian.org> | 2011-09-05 02:01:45 +0200 |
| commit | 288e907261c0b9aeab65105394973e26e198aa98 (patch) | |
| tree | 019f95f7a7a590507b86600b60224c1b70182e47 | |
| parent | e0d879550e0307a0c332f4b6ede8e1b960111cca (diff) | |
| download | perl-288e907261c0b9aeab65105394973e26e198aa98.tar.gz | |
Allow restricted hashes containing COWs to be cleared
| -rw-r--r-- | dist/base/t/fields.t | 6 | ||||
| -rw-r--r-- | 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 a3493ce2ee..d5f23b61d7 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'; } } @@ -1542,7 +1542,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", |