Make Storable freeze COWs properly

It was freezing them as read-only scalars.

diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index e6d403b..c6f9f70 100644 (file)
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -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) {

diff --git a/dist/Storable/t/restrict.t b/dist/Storable/t/restrict.t
index c27d874..a82c13d 100644 (file)
--- a/dist/Storable/t/restrict.t
+++ b/dist/Storable/t/restrict.t
@@ -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';
   }
 }