From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 5 Jun 2011 05:00:44 +0000 (-0700)
Subject: Make Storable freeze COWs properly
X-Git-Tag: accepted/trunk/20130322.191538~3939
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=a991bd3bfb069b09697e19297c2d3ae6305c766f;p=platform%2Fupstream%2Fperl.git

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
--- 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
--- 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';
   }
 }