diff options
author | Nicholas Clark <nick@ccl4.org> | 2002-04-14 00:43:02 +0100 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-04-14 15:20:58 +0000 |
commit | dfd4ef2f849f6c6c1ef68fdf03041001be25ade9 (patch) | |
tree | 95f2f7df3a87406f4db838e4719e3336e4cdd354 | |
parent | fd96152af2273c1b6313770ef4d2d59bd42b8407 (diff) | |
download | perl-dfd4ef2f849f6c6c1ef68fdf03041001be25ade9.tar.gz |
Re: restricted hashes are unblessable
Message-ID: <20020413224302.GB14889@Bagpuss.unfortu.net>
The function name sucks but can't think of anything better.
p4raw-id: //depot/perl@15914
-rw-r--r-- | lib/Hash/Util.pm | 1 | ||||
-rw-r--r-- | lib/Hash/Util.t | 37 | ||||
-rw-r--r-- | universal.c | 45 |
3 files changed, 82 insertions, 1 deletions
diff --git a/lib/Hash/Util.pm b/lib/Hash/Util.pm index 528711ae55..a1c9e64a54 100644 --- a/lib/Hash/Util.pm +++ b/lib/Hash/Util.pm @@ -71,6 +71,7 @@ Removes the restriction on the %hash's keyset. sub lock_keys (\%;@) { my($hash, @keys) = @_; + Internals::hv_clear_placeholders %$hash; if( @keys ) { my %keys = map { ($_ => 1) } @keys; my %original_keys = map { ($_ => 1) } keys %$hash; diff --git a/lib/Hash/Util.t b/lib/Hash/Util.t index 1046e32c54..a42a52e03c 100644 --- a/lib/Hash/Util.t +++ b/lib/Hash/Util.t @@ -6,7 +6,7 @@ BEGIN { chdir 't'; } } -use Test::More tests => 45; +use Test::More tests => 55; my @Exported_Funcs; BEGIN { @@ -168,3 +168,38 @@ TODO: { lock_keys(%ENV); eval { () = $ENV{I_DONT_EXIST} }; like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/, 'locked %ENV'); + +{ + my %hash; + + lock_keys(%hash, 'first'); + + is (scalar keys %hash, 0, "place holder isn't a key"); + $hash{first} = 1; + is (scalar keys %hash, 1, "we now have a key"); + delete $hash{first}; + is (scalar keys %hash, 0, "now no key"); + + unlock_keys(%hash); + + $hash{interregnum} = 1.5; + is (scalar keys %hash, 1, "key again"); + delete $hash{interregnum}; + is (scalar keys %hash, 0, "no key again"); + + lock_keys(%hash, 'second'); + + is (scalar keys %hash, 0, "place holder isn't a key"); + + eval {$hash{zeroeth} = 0}; + like ($@, + qr/^Attempt to access disallowed key 'zeroeth' in a restricted hash/, + 'locked key never mentioned before should fail'); + eval {$hash{first} = -1}; + like ($@, + qr/^Attempt to access disallowed key 'first' in a restricted hash/, + 'previously locked place holders should also fail'); + is (scalar keys %hash, 0, "and therefore there are no keys"); + $hash{second} = 1; + is (scalar keys %hash, 1, "we now have just one key"); +} diff --git a/universal.c b/universal.c index 85a09161d2..a9cb4ccbf9 100644 --- a/universal.c +++ b/universal.c @@ -169,6 +169,7 @@ XS(XS_utf8_unicode_to_native); XS(XS_utf8_native_to_unicode); XS(XS_Internals_SvREADONLY); XS(XS_Internals_SvREFCNT); +XS(XS_Internals_hv_clear_placeholders); void Perl_boot_core_UNIVERSAL(pTHX) @@ -187,6 +188,8 @@ Perl_boot_core_UNIVERSAL(pTHX) newXS("utf8::unicode_to_native", XS_utf8_unicode_to_native, file); newXSproto("Internals::SvREADONLY",XS_Internals_SvREADONLY, file, "\\[$%@];$"); newXSproto("Internals::SvREFCNT",XS_Internals_SvREFCNT, file, "\\[$%@];$"); + newXSproto("Internals::hv_clear_placeholders", + XS_Internals_hv_clear_placeholders, file, "\\%"); } @@ -500,3 +503,45 @@ XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */ XSRETURN_UNDEF; /* Can't happen. */ } +/* Maybe this should return the number of placeholders found in scalar context, + and a list of them in list context. */ +XS(XS_Internals_hv_clear_placeholders) +{ + dXSARGS; + HV *hv = (HV *) SvRV(ST(0)); + + /* I don't care how many parameters were passed in, but I want to avoid + the unused variable warning. */ + + items = HvPLACEHOLDERS(hv); + + if (items) { + HE *entry; + I32 riter = HvRITER(hv); + HE *eiter = HvEITER(hv); + hv_iterinit(hv); + while (items + && (entry + = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) { + SV *val = hv_iterval(hv, entry); + + if (val == &PL_sv_undef) { + + /* It seems that I have to go back in the front of the hash + API to delete a hash, even though I have a HE structure + pointing to the very entry I want to delete, and could hold + onto the previous HE that points to it. And it's easier to + go in with SVs as I can then specify the precomputed hash, + and don't have fun and games with utf8 keys. */ + SV *key = hv_iterkeysv(entry); + + hv_delete_ent (hv, key, G_DISCARD, HeHASH(entry)); + items--; + } + } + HvRITER(hv) = riter; + HvEITER(hv) = eiter; + } + + XSRETURN(0); +} |