This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Guarantee that, after unlocking, the hash is actually assignable.
authorJames E Keenan <jkeenan@cpan.org>
Thu, 30 Jul 2015 00:58:42 +0000 (20:58 -0400)
committerJames E Keenan <jkeenan@cpan.org>
Tue, 4 Aug 2015 23:54:32 +0000 (19:54 -0400)
Hash::Util::unlock_hashref_recurse(); Hash::Util::unlock_hash_recurse().

Thanks to report from Diab Jerius.

For: RT #125721

ext/Hash-Util/lib/Hash/Util.pm
ext/Hash-Util/t/Util.t

index da02510..40de862 100644 (file)
@@ -34,7 +34,7 @@ our @EXPORT_OK  = qw(
 
                      hash_traversal_mask
                     );
-our $VERSION = '0.18';
+our $VERSION = '0.19';
 require XSLoader;
 XSLoader::load();
 
@@ -364,7 +364,7 @@ sub unlock_hashref_recurse {
         if (defined($type) and $type eq 'HASH') {
             unlock_hashref_recurse($value);
         }
-        Internals::SvREADONLY($value,1);
+        Internals::SvREADONLY($value,0);
     }
     unlock_ref_keys($hash);
     return $hash;
index 031d074..b9be7bd 100644 (file)
@@ -45,7 +45,7 @@ BEGIN {
                      hv_store
                      lock_hash_recurse unlock_hash_recurse
                     );
-    plan tests => 236 + @Exported_Funcs;
+    plan tests => 244 + @Exported_Funcs;
     use_ok 'Hash::Util', @Exported_Funcs;
 }
 foreach my $func (@Exported_Funcs) {
@@ -530,6 +530,7 @@ ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed");
 }
 
 {
+    # lock_hash_recurse / unlock_hash_recurse
     my %hash = (
         a   => 'alpha',
         b   => [ qw( beta gamma delta ) ],
@@ -549,6 +550,43 @@ ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed");
         "unlock_hash_recurse(): top-level hash unlocked" );
     ok( hash_unlocked(%{$hash{d}}),
         "unlock_hash_recurse(): element which is hashref unlocked" );
+    {
+        local $@;
+        eval { $hash{d} = { theta => 'kappa' }; };
+        ok(! $@, "No error; can assign to unlocked hash")
+            or diag($@);
+    }
+    ok( hash_unlocked(%{$hash{c}[1]}),
+        "unlock_hash_recurse(): element which is hashref in array ref not locked" );
+}
+
+{
+    # lock_hashref_recurse / unlock_hashref_recurse
+    my %hash = (
+        a   => 'alpha',
+        b   => [ qw( beta gamma delta ) ],
+        c   => [ 'epsilon', { zeta => 'eta' }, ],
+        d   => { theta => 'iota' },
+    );
+    Hash::Util::lock_hashref_recurse(\%hash);
+    ok( hash_locked(%hash),
+        "lock_hash_recurse(): top-level hash locked" );
+    ok( hash_locked(%{$hash{d}}),
+        "lock_hash_recurse(): element which is hashref locked" );
+    ok( ! hash_locked(%{$hash{c}[1]}),
+        "lock_hash_recurse(): element which is hashref in array ref not locked" );
+
+    Hash::Util::unlock_hashref_recurse(\%hash);
+    ok( hash_unlocked(%hash),
+        "unlock_hash_recurse(): top-level hash unlocked" );
+    ok( hash_unlocked(%{$hash{d}}),
+        "unlock_hash_recurse(): element which is hashref unlocked" );
+    {
+        local $@;
+        eval { $hash{d} = { theta => 'kappa' }; };
+        ok(! $@, "No error; can assign to unlocked hash")
+            or diag($@);
+    }
     ok( hash_unlocked(%{$hash{c}[1]}),
         "unlock_hash_recurse(): element which is hashref in array ref not locked" );
 }