diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2011-06-04 11:58:14 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-06-04 14:34:30 -0700 |
| commit | fb2352ebbcdd380053ad8408a0613965b0ec2950 (patch) | |
| tree | 97471c28069315b6940886ea3aa2a9355ec2bd43 | |
| parent | e5accad2c334d0d98a2eb0bcfa8f8363dfc3c78a (diff) | |
| download | perl-fb2352ebbcdd380053ad8408a0613965b0ec2950.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'; } } @@ -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", |