Document hashref_locked() and hashref_unlocked(). Add tests for them, include debugging by Father C++.

Make lock_hash_recurse() unlock_hash_recurse() exportable; include them in
SYNOPSIS; write tests for them.

Revise 'carp test' test. In general, tests of error messages should be written
with like() rather than is().  Why?  Because we rarely want to test for the
complete error message if that requires us to exactly calculate strings such
as the line number at which an error occurred.

2 files changed, 78 insertions, 12 deletions

diff --git a/ext/Hash-Util/lib/Hash/Util.pm b/ext/Hash-Util/lib/Hash/Util.pm
index cd84dfeeec..d8a6ec888b 100644
--- a/ext/Hash-Util/lib/Hash/Util.pm
+++ b/ext/Hash-Util/lib/Hash/Util.pm
@@ -29,6 +29,7 @@ our @EXPORT_OK  = qw(
                      hidden_ref_keys legal_ref_keys
 
                      hash_seed hv_store
+                     lock_hash_recurse unlock_hash_recurse
                     );
 our $VERSION = '0.12';
 require XSLoader;
@@ -72,6 +73,7 @@ Hash::Util - A selection of general-utility hash subroutines
                      hidden_ref_keys legal_ref_keys
 
                      hash_seed hv_store
+                     lock_hash_recurse unlock_hash_recurse
                    );
 
   %hash = (foo => 42, bar => 23);
@@ -142,8 +144,8 @@ the hash before you call lock_keys() so this shouldn't be a problem.
 
 Removes the restriction on the %hash's keyset.
 
-B<Note> that if any of the values of the hash have been locked they will not be unlocked
-after this sub executes.
+B<Note> that if any of the values of the hash have been locked they will not
+be unlocked after this sub executes.
 
 Both routines return a reference to the hash operated on.
 
@@ -314,9 +316,9 @@ lock_hash() locks an entire hash and any hashes it references recursively,
 making all keys and values read-only. No value can be changed, no keys can
 be added or deleted.
 
-B<Only> recurses into hashes that are referenced by another hash. Thus a
-Hash of Hashes (HoH) will all be restricted, but a Hash of Arrays of Hashes
-(HoAoH) will only have the top hash restricted.
+This method B<only> recurses into hashes that are referenced by another hash.
+Thus a Hash of Hashes (HoH) will all be restricted, but a Hash of Arrays of
+Hashes (HoAoH) will only have the top hash restricted.
 
     unlock_hash_recurse(%hash);
 
@@ -359,8 +361,11 @@ sub unlock_hashref_recurse {
 sub   lock_hash_recurse (\%) {   lock_hashref_recurse(@_) }
 sub unlock_hash_recurse (\%) { unlock_hashref_recurse(@_) }
 
+=item B<hashref_locked>
+
 =item B<hash_locked>
 
+  hashref_locked(\%hash) and print "Hash is locked!\n";
   hash_locked(%hash) and print "Hash is locked!\n";
 
 Returns true if the hash and its keys are locked.
@@ -369,13 +374,16 @@ Returns true if the hash and its keys are locked.
 
 sub hashref_locked {
     my $hash=shift;
-    Internals::SvREADONLY($hash) ? return 0 : return 1;
+    Internals::SvREADONLY(%$hash);
 }
 
 sub hash_locked(\%) { hashref_locked(@_) }
 
+=item B<hashref_unlocked>
+
 =item B<hash_unlocked>
 
+  hashref_unlocked(\%hash) and print "Hash is unlocked!\n";
   hash_unlocked(%hash) and print "Hash is unlocked!\n";
 
 Returns true if the hash and its keys are unlocked.
@@ -384,7 +392,7 @@ Returns true if the hash and its keys are unlocked.
 
 sub hashref_unlocked {
     my $hash=shift;
-    (! Internals::SvREADONLY($hash)) ? return 1 : return 0;
+    !Internals::SvREADONLY(%$hash);
 }
 
 sub hash_unlocked(\%) { hashref_unlocked(@_) }
diff --git a/ext/Hash-Util/t/Util.t b/ext/Hash-Util/t/Util.t
index fa0f66c0e6..d02defe9de 100644
--- a/ext/Hash-Util/t/Util.t
+++ b/ext/Hash-Util/t/Util.t
@@ -34,8 +34,9 @@ BEGIN {
                      hidden_ref_keys legal_ref_keys
 
                      hash_seed hv_store
+                     lock_hash_recurse unlock_hash_recurse
                     );
-    plan tests => 208 + @Exported_Funcs;
+    plan tests => 226 + @Exported_Funcs;
     use_ok 'Hash::Util', @Exported_Funcs;
 }
 foreach my $func (@Exported_Funcs) {
@@ -155,15 +156,14 @@ is( $hash{locked}, 42,  'unlock_value' );
 {
     my %hash = (foo => 42, bar => undef);
     eval { lock_keys(%hash, qw(foo baz)); };
-    is( $@, sprintf("Hash has key 'bar' which is not in the new key ".
-                    "set at %s line %d.\n", __FILE__, __LINE__ - 2),
+    like( $@, qr/^Hash has key 'bar' which is not in the new key set/,
                     'carp test' );
 }
 
 {
     my %hash = (foo => 42, bar => 23);
     lock_hash( %hash );
-    ok( hashref_locked( { %hash } ), 'hashref_locked' );
+    ok( hashref_locked( \%hash ), 'hashref_locked' );
     ok( hash_locked( %hash ), 'hash_locked' );
 
     ok( Internals::SvREADONLY(%hash),'Was locked %hash' );
@@ -179,10 +179,23 @@ is( $hash{locked}, 42,  'unlock_value' );
     ok( !Internals::SvREADONLY($hash{bar}),'Was unlocked $hash{bar}' );
 }
 
+{
+    my %hash = (foo => 42, bar => 23);
+    ok( ! hashref_locked( { %hash } ), 'hashref_locked negated' );
+    ok( ! hash_locked( %hash ), 'hash_locked negated' );
+
+    lock_hash( %hash );
+    ok( ! hashref_unlocked( \%hash ), 'hashref_unlocked negated' );
+    ok( ! hash_unlocked( %hash ), 'hash_unlocked negated' );
+}
 
 lock_keys(%ENV);
 eval { () = $ENV{I_DONT_EXIST} };
-like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/,   'locked %ENV');
+like(
+    $@,
+    qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/,
+    'locked %ENV'
+);
 
 {
     my %hash;
@@ -444,6 +457,17 @@ ok($hash_seed >= 0, "hash_seed $hash_seed");
     is("@keys","0 2 4 6 8",'lock_ref_keys_plus() @keys DDS/t');
 }
 {
+    my %hash=(0..9, 'a' => 'alpha');
+    lock_ref_keys_plus(\%hash,'a'..'f');
+    ok(Internals::SvREADONLY(%hash),'lock_ref_keys_plus args overlap');
+    my @hidden=sort(hidden_keys(%hash));
+    my @legal=sort(legal_keys(%hash));
+    my @keys=sort(keys(%hash));
+    is("@hidden","b c d e f",'lock_ref_keys_plus() @hidden overlap');
+    is("@legal","0 2 4 6 8 a b c d e f",'lock_ref_keys_plus() @legal overlap');
+    is("@keys","0 2 4 6 8 a",'lock_ref_keys_plus() @keys overlap');
+}
+{
     my %hash=(0..9);
     lock_keys_plus(%hash,'a'..'f');
     ok(Internals::SvREADONLY(%hash),'lock_keys_plus args DDS/t');
@@ -454,6 +478,17 @@ ok($hash_seed >= 0, "hash_seed $hash_seed");
     is("@legal","0 2 4 6 8 a b c d e f",'lock_keys_plus() @legal DDS/t 3');
     is("@keys","0 2 4 6 8",'lock_keys_plus() @keys DDS/t 3');
 }
+{
+    my %hash=(0..9, 'a' => 'alpha');
+    lock_keys_plus(%hash,'a'..'f');
+    ok(Internals::SvREADONLY(%hash),'lock_keys_plus args overlap non-ref');
+    my @hidden=sort(hidden_keys(%hash));
+    my @legal=sort(legal_keys(%hash));
+    my @keys=sort(keys(%hash));
+    is("@hidden","b c d e f",'lock_keys_plus() @hidden overlap non-ref');
+    is("@legal","0 2 4 6 8 a b c d e f",'lock_keys_plus() @legal overlap non-ref');
+    is("@keys","0 2 4 6 8 a",'lock_keys_plus() @keys overlap non-ref');
+}
 
 {
     my %hash = ('a'..'f');
@@ -472,3 +507,26 @@ ok($hash_seed >= 0, "hash_seed $hash_seed");
     is_deeply(\@ph, \@bam, "Placeholders in place");
 }
 
+{
+    my %hash = (
+        a   => 'alpha',
+        b   => [ qw( beta gamma delta ) ],
+        c   => [ 'epsilon', { zeta => 'eta' }, ],
+        d   => { theta => 'iota' },
+    );
+    lock_hash_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" );
+
+    unlock_hash_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" );
+    ok( hash_unlocked(%{$hash{c}[1]}),
+        "unlock_hash_recurse(): element which is hashref in array ref not locked" );
+}