Add subroutines hash_locked() and hashref_locked() to Hash::Util.

Make @EXPORT_OK, synopsis, and list of functions tested with
can_ok() consistent with one another.  Rationalize the way
functions are grouped within @EXPORT_OK and the other locations.
Add tests for hash_locked(), hashref_locked(), hash_unlocked() and
hashref_unlocked().  Add descriptions for several unit tests which
lacked them.

For RT #112126.

2 files changed, 52 insertions, 21 deletions

diff --git a/ext/Hash-Util/lib/Hash/Util.pm b/ext/Hash-Util/lib/Hash/Util.pm
index 8555821309..dd2bb33ec5 100644
--- a/ext/Hash-Util/lib/Hash/Util.pm
+++ b/ext/Hash-Util/lib/Hash/Util.pm
@@ -17,17 +17,18 @@ our @EXPORT_OK  = qw(
                      lock_keys unlock_keys
                      lock_value unlock_value
                      lock_hash unlock_hash
-                     lock_keys_plus hash_locked
+                     lock_keys_plus
+                     hash_locked hash_unlocked
+                     hashref_locked hashref_unlocked
                      hidden_keys legal_keys
 
                      lock_ref_keys unlock_ref_keys
                      lock_ref_value unlock_ref_value
                      lock_hashref unlock_hashref
-                     lock_ref_keys_plus hashref_locked
+                     lock_ref_keys_plus
                      hidden_ref_keys legal_ref_keys
 
                      hash_seed hv_store
-
                     );
 our $VERSION = '0.11';
 require XSLoader;
@@ -53,12 +54,24 @@ Hash::Util - A selection of general-utility hash subroutines
   # Restricted hashes
 
   use Hash::Util qw(
-                     hash_seed all_keys
+                     fieldhash fieldhashes
+
+                     all_keys
                      lock_keys unlock_keys
                      lock_value unlock_value
                      lock_hash unlock_hash
-                     lock_keys_plus hash_locked
+                     lock_keys_plus
+                     hash_locked hash_unlocked
+                     hashref_locked hashref_unlocked
                      hidden_keys legal_keys
+
+                     lock_ref_keys unlock_ref_keys
+                     lock_ref_value unlock_ref_value
+                     lock_hashref unlock_hashref
+                     lock_ref_keys_plus
+                     hidden_ref_keys legal_ref_keys
+
+                     hash_seed hv_store
                    );
 
   %hash = (foo => 42, bar => 23);
@@ -346,6 +359,20 @@ sub unlock_hashref_recurse {
 sub   lock_hash_recurse (\%) {   lock_hashref_recurse(@_) }
 sub unlock_hash_recurse (\%) { unlock_hashref_recurse(@_) }
 
+=item B<hash_locked>
+
+  hash_locked(%hash) and print "Hash is locked!\n";
+
+Returns true if the hash and its keys are locked.
+
+=cut
+
+sub hashref_locked {
+    my $hash=shift;
+    Internals::SvREADONLY($hash) ? return 0 : return 1;
+}
+
+sub hash_locked(\%) { hashref_locked(@_) }
 
 =item B<hash_unlocked>
 
@@ -357,7 +384,7 @@ Returns true if the hash and its keys are unlocked.
 
 sub hashref_unlocked {
     my $hash=shift;
-    return Internals::SvREADONLY($hash)
+    (! Internals::SvREADONLY($hash)) ? return 1 : return 0;
 }
 
 sub hash_unlocked(\%) { hashref_unlocked(@_) }
diff --git a/ext/Hash-Util/t/Util.t b/ext/Hash-Util/t/Util.t
index 74d823db05..fa0f66c0e6 100644
--- a/ext/Hash-Util/t/Util.t
+++ b/ext/Hash-Util/t/Util.t
@@ -16,22 +16,26 @@ use Test::More;
 my @Exported_Funcs;
 BEGIN {
     @Exported_Funcs = qw(
-                     hash_seed all_keys
+                     fieldhash fieldhashes
+
+                     all_keys
                      lock_keys unlock_keys
                      lock_value unlock_value
                      lock_hash unlock_hash
-                     lock_keys_plus hash_locked
+                     lock_keys_plus
+                     hash_locked hash_unlocked
+                     hashref_locked hashref_unlocked
                      hidden_keys legal_keys
 
                      lock_ref_keys unlock_ref_keys
                      lock_ref_value unlock_ref_value
                      lock_hashref unlock_hashref
-                     lock_ref_keys_plus hashref_locked
+                     lock_ref_keys_plus
                      hidden_ref_keys legal_ref_keys
-                     hv_store
 
+                     hash_seed hv_store
                     );
-    plan tests => 204 + @Exported_Funcs;
+    plan tests => 208 + @Exported_Funcs;
     use_ok 'Hash::Util', @Exported_Funcs;
 }
 foreach my $func (@Exported_Funcs) {
@@ -43,7 +47,7 @@ lock_keys(%hash);
 eval { $hash{baz} = 99; };
 like( $@, qr/^Attempt to access disallowed key 'baz' in a restricted hash/,
                                                        'lock_keys()');
-is( $hash{bar}, 23 );
+is( $hash{bar}, 23, '$hash{bar} == 23' );
 ok( !exists $hash{baz},'!exists $hash{baz}' );
 
 delete $hash{bar};
@@ -70,7 +74,7 @@ like( $@, qr/^Attempt to delete readonly key 'locked' from a restricted hash/,
 eval { $hash{locked} = 42; };
 like( $@, qr/^Modification of a read-only value attempted/,
                                            'trying to change a locked key' );
-is( $hash{locked}, 'yep' );
+is( $hash{locked}, 'yep', '$hash{locked} is yep' );
 
 eval { delete $hash{I_dont_exist} };
 like( $@, qr/^Attempt to delete disallowed key 'I_dont_exist' from a restricted hash/,
@@ -108,24 +112,23 @@ is( $hash{locked}, 42,  'unlock_value' );
     lock_value(%hash, 'RO');
 
     eval { %hash = (KEY => 1) };
-    like( $@, qr/^Attempt to delete readonly key 'RO' from a restricted hash/ );
+    like( $@, qr/^Attempt to delete readonly key 'RO' from a restricted hash/,
+        'attempt to delete readonly key from restricted hash' );
 }
 
 {
     my %hash = (KEY => 1, RO => 2);
     lock_keys(%hash);
     eval { %hash = (KEY => 1, RO => 2) };
-    is( $@, '');
+    is( $@, '', 'No error message, as expected');
 }
 
-
-
 {
     my %hash = ();
     lock_keys(%hash, qw(foo bar));
     is( keys %hash, 0,  'lock_keys() w/keyset shouldnt add new keys' );
     $hash{foo} = 42;
-    is( keys %hash, 1 );
+    is( keys %hash, 1, '1 element in hash' );
     eval { $hash{wibble} = 42 };
     like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/,
                         'write threw error (locked)');
@@ -135,7 +138,6 @@ is( $hash{locked}, 42,  'unlock_value' );
     is( $@, '', 'unlock_keys' );
 }
 
-
 {
     my %hash = (foo => 42, bar => undef, baz => 0);
     lock_keys(%hash, qw(foo bar baz up down));
@@ -150,7 +152,6 @@ is( $hash{locked}, 42,  'unlock_value' );
           'locked "wibble"' );
 }
 
-
 {
     my %hash = (foo => 42, bar => undef);
     eval { lock_keys(%hash, qw(foo baz)); };
@@ -159,16 +160,19 @@ is( $hash{locked}, 42,  'unlock_value' );
                     'carp test' );
 }
 
-
 {
     my %hash = (foo => 42, bar => 23);
     lock_hash( %hash );
+    ok( hashref_locked( { %hash } ), 'hashref_locked' );
+    ok( hash_locked( %hash ), 'hash_locked' );
 
     ok( Internals::SvREADONLY(%hash),'Was locked %hash' );
     ok( Internals::SvREADONLY($hash{foo}),'Was locked $hash{foo}' );
     ok( Internals::SvREADONLY($hash{bar}),'Was locked $hash{bar}' );
 
     unlock_hash ( %hash );
+    ok( hashref_unlocked( { %hash } ), 'hashref_unlocked' );
+    ok( hash_unlocked( %hash ), 'hash_unlocked' );
 
     ok( !Internals::SvREADONLY(%hash),'Was unlocked %hash' );
     ok( !Internals::SvREADONLY($hash{foo}),'Was unlocked $hash{foo}' );