This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make Storable freeze COWs properly
authorFather Chrysostomos <sprout@cpan.org>
Sun, 5 Jun 2011 05:00:44 +0000 (22:00 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 5 Jun 2011 05:00:44 +0000 (22:00 -0700)
It was freezing them as read-only scalars.

dist/Storable/Storable.xs
dist/Storable/t/restrict.t

index e6d403b..c6f9f70 100644 (file)
@@ -2435,7 +2435,8 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
                         
                         /* Implementation of restricted hashes isn't nicely
                            abstracted:  */
-                       if ((hash_flags & SHV_RESTRICTED) && SvREADONLY(val)) {
+                       if ((hash_flags & SHV_RESTRICTED)
+                        && SvREADONLY(val) && !SvIsCOW(val)) {
                                flags |= SHV_K_LOCKED;
                        }
 
@@ -2527,7 +2528,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
                            abstracted:  */
                         flags
                             = (((hash_flags & SHV_RESTRICTED)
-                                && SvREADONLY(val))
+                                && SvREADONLY(val) && !SvIsCOW(val))
                                              ? SHV_K_LOCKED : 0);
 
                         if (val == &PL_sv_placeholder) {
index c27d874..a82c13d 100644 (file)
@@ -36,7 +36,7 @@ sub BEGIN {
 
 use Storable qw(dclone freeze thaw);
 use Hash::Util qw(lock_hash unlock_value);
-use Test::More tests => 100;
+use Test::More tests => 104;
 
 my %hash = (question => '?', answer => 42, extra => 'junk', undef => undef);
 lock_hash %hash;
@@ -110,5 +110,11 @@ for $Storable::canonical (0, 1) {
       eval { $copy->{$k} = undef } ;
       is($@, '', "Can assign to reserved key '$k'?");
     }
+
+    my %hv;
+    $hv{a} = __PACKAGE__;
+    lock_hash %hv;
+    my $hv2 = &$cloner(\%hv);
+    ok eval { $$hv2{a} = 70 }, 'COWs do not become read-only';
   }
 }