New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Hash::Util export bug #12025
Comments
From rich.a.haberman@gmail.comCreated by rich.a.haberman@gmail.comThis is a bug report for perl from rich.a.haberman@gmail.com, ----------------------------------------------------------------- The docs for Hash::Util state to use "hash_unlocked" to test that a %hash is hash_unlocked hash_unlocked(%hash) and print "Hash is unlocked!\n"; Returns true if the hash and its keys are unlocked. But the docs for Hash::Util show that only "hash_locked" can be imported use Hash::Util qw( and the Synopsis states: # Ways to inspect the properties of a restricted hash In Hash::Util.pm there is no "hash_locked", there is only: sub hash_unlocked(\%) { hashref_unlocked(@_) } and the @EXPORT_OK in Hash::Util.pm is: our @EXPORT_OK = qw( all_keys lock_ref_keys unlock_ref_keys hash_seed hv_store ); so there is no way to import "hash_unlocked" Fix: change "hash_locked" to "hash_unlocked" in @EXPORT_OK of Hash::Util.pm, Perl Info
|
From @jkeenanOn Thu Mar 29 20:25:21 2012, rich.a.haberman@gmail.com wrote:
This appears to be a valid complaint; the line of approach to fixing it cc-ing module's authors listed in documentation for comment. |
The RT System itself - Status changed from 'new' to 'open' |
From @demerphqOn 21 April 2012 15:07, James E Keenan via RT <perlbug-followup@perl.org> wrote:
And/or add hash_locked() as a negation of hash_unlocked() Yves |
From @jkeenanOn Sun Apr 22 03:54:42 2012, demerphq wrote:
Please review the patch attached. Thank you very much. |
From @jkeenan0001-Add-subroutines-hash_locked-and-hashref_locked-to-Ha.patchFrom daa8ff31e8b76322f40147e217e45ac0cd162a4a Mon Sep 17 00:00:00 2001
From: jkeenan <jkeenan@cpan.org>
Date: Sun, 22 Apr 2012 20:59:33 -0400
Subject: [PATCH] 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.
---
ext/Hash-Util/lib/Hash/Util.pm | 39 +++++++++++++++++++++++++++++++++------
ext/Hash-Util/t/Util.t | 34 +++++++++++++++++++---------------
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 8555821..dd2bb33 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 74d823d..fa0f66c 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}' );
--
1.6.3.2
|
From @cpansproutOn Sun Apr 22 18:54:29 2012, jkeenan wrote:
Looks good. I see that you fixed hash_unlocked, which was giving a I’ve pushed these to the sprout/misc-post-5.16 branch for now. -- Father Chrysostomos |
From @jkeenanOn Tue Apr 24 18:03:20 2012, sprout wrote:
Note: I suspect that since I added some functions to the module, I Would changing it within the module be sufficient? I got a message like ##### Hash::Util object version 0.11 does not match $Hash::Util::VERSION 0.12 ##### Thank you very mcuh. |
From @cpansproutOn Wed Apr 25 18:13:18 2012, jkeenan wrote:
Usually leaving it to the committers is sufficient. If the patch is not -- Father Chrysostomos |
From @demerphqOn 26 April 2012 03:13, James E Keenan via RT <perlbug-followup@perl.org> wrote:
Try doing a full clean on the code then re-making. I think there might Yves -- |
From @cpansproutOn Thu Apr 26 00:55:53 2012, demerphq wrote:
To avoid recompiling everything, sometimes I just delete the Makefile -- Father Chrysostomos |
From @jkeenanOn Tue Apr 24 18:03:20 2012, sprout wrote:
Summary: The more I look at Hash::Util, the more I think it is wrong. In https://rt-archive.perl.org/perl5/Ticket/Display.html?id=112126, Rich Haberman I submitted a patch At that point, I wanted to see how well t/Util.t exercised Hash-Util's At that point I felt I was in a good position to see how good the test ------------------------------------------- ------ ------ 4 subroutines -- lock_hashref_recurse(), lock_hash_recurse(), First, I explicitly locked a hash, tested it with hash_locked() and { # snip # snip My results DWIMmed: ok 58 - hashref_locked I next created a hash which I did not lock. I would have expected that my %hash = (foo => 42, bar => 23); lock_hash( %hash ); But, to my surprise, all four of these tests FAILed and had to be { ok( hashref_unlocked( { %hash } ), 'hashref_unlocked' ); Now it could be that my implementation of these functions is simply sub hashref_locked { sub hashref_unlocked { sub hash_unlocked(\%) { hashref_unlocked(@_) } As noted above, only the *_unlocked functions are implemented in version sub hashref_unlocked { sub hash_unlocked(\%) { hashref_unlocked(@_) } I don't think my implementations differ too much from that, but then I'm increasingly suspicious of the use of Internals::SvREADONLY in XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */ /* [perl #77776] - called as &foo() not foo() */ sv = SvRV(svz); if (items == 1) { To sum up: My attempts to correct evident deficiencies in Hash-Util are stumbling. Comments? Thank you very much. |
From @cpansproutOn Sat Apr 28 17:41:43 2012, jkeenan wrote:
I think I responded a little too hastily earlier. You are returning the same thing in both hashref_locked and In the first, you have ‘return 0’ when SvREADONLY is true. In the second, you have ‘return 0’ when !SvREADONLY is false. Your double negatives make my head hurt. I find it much easier to read sub hashref_locked { sub hashref_unlocked { which makes the difference obvious.
That’s wrong, because the SvREADONLY flag means locked.
SvREADONLY will return true for any read-only scalar, like $]. SvREADONLY on a hash means it is locked. Internally, at the C level, SvREADONLY also means copy-on-write, which Knowing that, I find the code self-documenting, but I’m getting too
-- Father Chrysostomos |
From @doyOn Sat, Apr 28, 2012 at 05:59:57PM -0700, Father Chrysostomos via RT wrote:
Which makes me wonder why SvREADONLY is exposed to perl-space at all. -doy |
From @jkeenanOn Sat Apr 28 17:59:57 2012, sprout wrote:
Let's say I try that. (See: ########## Inline Patchdiff --git a/lib/Hash/Util.pm b/lib/Hash/Util.pm
index bfe101b..d830b0d 100644
--- a/lib/Hash/Util.pm
+++ b/lib/Hash/Util.pm
@@ -372,7 +372,7 @@ 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(@_) }
@@ -390,7 +390,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(@_) }
Unfortunately, two tests that were passing now fail while two tests that ok 58 - hashref_locked # Failed (TODO) test 'hashref_locked negated' # Failed (TODO) test 'hash_locked negated' |
From @cpansproutOn Sat Apr 28 19:55:04 2012, doy@tozt.net wrote:
I would favour that for the sake of speed. Is Internals::SvREADONLY -- Father Chrysostomos |
From @cpansproutOn Sat Apr 28 19:59:55 2012, jkeenan wrote:
To the point of getting things backward myself!
Well, this is a good lesson in humility. I got them reversed, too. Now move the exclamation mark from hashref_locked to hashref_unlocked. :-) -- Father Chrysostomos |
From @jkeenanOn Sat Apr 28 21:17:11 2012, sprout wrote:
Unfortunately, that simply switches around the tests that FAIL or ########## $ git show e3599b5 Father C said switch the \! Inline Patchdiff --git a/lib/Hash/Util.pm b/lib/Hash/Util.pm
index d830b0d..bb8a981 100644
--- a/lib/Hash/Util.pm
+++ b/lib/Hash/Util.pm
@@ -372,7 +372,7 @@ Returns true if the hash and its keys are locked.
sub hashref_locked {
my $hash=shift;
- !Internals::SvREADONLY($hash);
+ Internals::SvREADONLY($hash);
}
sub hash_locked(\%) { hashref_locked(@_) }
@@ -390,7 +390,7 @@ Returns true if the hash and its keys are unlocked.
sub hashref_unlocked {
my $hash=shift;
- Internals::SvREADONLY($hash);
+ !Internals::SvREADONLY($hash);
}
sub hash_unlocked(\%) { hashref_unlocked(@_) }
##########
PERL_DL_NONLAZY=1 /usr/local/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t # Failed test 'hash_locked' Test Summary Report t/Util.t (Wstat: 512 Tests: 246 Failed: 2) Thank you very much. |
From @jkeenanOn Sat Apr 28 21:15:41 2012, sprout wrote:
Jesse: Patches to the XS welcome! After we solve these immediate Father C: The attached list is a start. It is the output of: ack -l SvREADONLY lib/ ext/ dist/ cpan/ > Then, manually edit the result to eliminate generated .c files. Thank you very much. |
From @jkeenanlib/constant.pm |
From @cpansproutOn Sun Apr 29 05:21:08 2012, jkeenan wrote:
I see it begins with:
which I had forgotten about. constant.pm needs Internals::SvREADONLY, -- Father Chrysostomos |
From @cpansproutOn Sun Apr 29 05:00:19 2012, jkeenan wrote:
Instead of giving another armchair response, I thought I’d better You’ll notice that lock_ref_keys does Internals::SvREADONLY(%$hash), See the attached diff, which is against the 112126/sprout branch in your -- Father Chrysostomos |
From @cpansproutInline Patchdiff --git a/lib/Hash/Util.pm b/lib/Hash/Util.pm
index bb8a981..3eff6e7 100644
--- a/lib/Hash/Util.pm
+++ b/lib/Hash/Util.pm
@@ -372,7 +372,7 @@ Returns true if the hash and its keys are locked.
sub hashref_locked {
my $hash=shift;
- Internals::SvREADONLY($hash);
+ Internals::SvREADONLY(%$hash);
}
sub hash_locked(\%) { hashref_locked(@_) }
@@ -390,7 +390,7 @@ Returns true if the hash and its keys are unlocked.
sub hashref_unlocked {
my $hash=shift;
- !Internals::SvREADONLY($hash);
+ !Internals::SvREADONLY(%$hash);
}
sub hash_unlocked(\%) { hashref_unlocked(@_) }
diff --git a/t/Util.t b/t/Util.t
index ba425de..2f39325 100644
--- a/t/Util.t
+++ b/t/Util.t
@@ -152,7 +152,7 @@ is( $hash{locked}, 42, 'unlock_value' );
{
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' );
@@ -175,7 +175,7 @@ TODO: {
ok( ! hash_locked( %hash ), 'hash_locked negated' );
lock_hash( %hash );
- ok( ! hashref_unlocked( { %hash } ), 'hashref_unlocked negated' );
+ ok( ! hashref_unlocked( \%hash ), 'hashref_unlocked negated' );
ok( ! hash_unlocked( %hash ), 'hash_unlocked negated' );
}
|
From @jkeenanOn Sun Apr 29 10:53:12 2012, sprout wrote:
Ah! The power of multiple application of multiple eyeballs!
Yes, that resolved the problem. I applied your patch to that branch, I believe that if you apply the patch attached, Thank you very much. |
From @jkeenan0001-Document-hashref_locked-and-hashref_unlocked-.-Add-t.patchFrom 90875ac8aee0f0eadb79109619e4598efabafa58 Mon Sep 17 00:00:00 2001
From: jkeenan <jkeenan@cpan.org>
Date: Sun, 29 Apr 2012 20:15:43 -0400
Subject: [PATCH] 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.
---
ext/Hash-Util/lib/Hash/Util.pm | 22 +++++++++----
ext/Hash-Util/t/Util.t | 68 +++++++++++++++++++++++++++++++++++++---
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 dd2bb33..5075af3 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.11';
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 fa0f66c..d02defe 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" );
+}
--
1.6.3.2
|
From @nwc10On Sat, Apr 28, 2012 at 09:54:31PM -0500, Jesse Luehrs wrote:
I think Hash::Util would be easier to read if it better encapsulated the Yes, constant.pm is (currently) using Internals::SvREADONLY(), but for the Nicholas Clark |
From @cpansproutOn Sun Apr 29 18:30:28 2012, jkeenan wrote:
Applied as 0857953 (Apr 22 patch) and 5114d26. Thank you. -- Father Chrysostomos |
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#112126 (status was 'resolved')
Searchable as RT112126$
The text was updated successfully, but these errors were encountered: