4 if( $ENV{PERL_CORE} ) {
9 use Test::More tests => 61;
14 @Exported_Funcs = qw(lock_keys unlock_keys
15 lock_value unlock_value
18 use_ok 'Hash::Util', @Exported_Funcs;
20 foreach my $func (@Exported_Funcs) {
21 can_ok __PACKAGE__, $func;
24 my %hash = (foo => 42, bar => 23, locked => 'yep');
26 eval { $hash{baz} = 99; };
27 like( $@, qr/^Attempt to access disallowed key 'baz' in a restricted hash/,
30 ok( !exists $hash{baz} );
33 ok( !exists $hash{bar} );
37 eval { () = $hash{i_dont_exist} };
38 like( $@, qr/^Attempt to access disallowed key 'i_dont_exist' in a restricted hash/ );
40 lock_value(%hash, 'locked');
41 eval { print "# oops" if $hash{four} };
42 like( $@, qr/^Attempt to access disallowed key 'four' in a restricted hash/ );
44 eval { $hash{"\x{2323}"} = 3 };
45 like( $@, qr/^Attempt to access disallowed key '(.*)' in a restricted hash/,
48 eval { delete $hash{locked} };
49 like( $@, qr/^Attempt to delete readonly key 'locked' from a restricted hash/,
50 'trying to delete a locked key' );
51 eval { $hash{locked} = 42; };
52 like( $@, qr/^Modification of a read-only value attempted/,
53 'trying to change a locked key' );
54 is( $hash{locked}, 'yep' );
56 eval { delete $hash{I_dont_exist} };
57 like( $@, qr/^Attempt to delete disallowed key 'I_dont_exist' from a restricted hash/,
58 'trying to delete a key that doesnt exist' );
60 ok( !exists $hash{I_dont_exist} );
63 $hash{I_dont_exist} = 42;
64 is( $hash{I_dont_exist}, 42, 'unlock_keys' );
66 eval { $hash{locked} = 42; };
67 like( $@, qr/^Modification of a read-only value attempted/,
68 ' individual key still readonly' );
69 eval { delete $hash{locked} },
70 is( $@, '', ' but can be deleted :(' );
72 unlock_value(%hash, 'locked');
74 is( $hash{locked}, 42, 'unlock_value' );
78 # local $TODO = 'assigning to a hash screws with locked keys';
80 my %hash = ( foo => 42, locked => 23 );
83 lock_value(%hash, 'locked');
84 eval { %hash = ( wubble => 42 ) }; # we know this will bomb
85 like( $@, qr/^Attempt to clear a restricted hash/ );
87 eval { unlock_value(%hash, 'locked') }; # but this shouldn't
88 is( $@, '', 'unlock_value() after denied assignment' );
90 is_deeply( \%hash, { foo => 42, locked => 23 },
91 'hash should not be altered by denied assignment' );
96 my %hash = (KEY => 'val', RO => 'val');
98 lock_value(%hash, 'RO');
100 eval { %hash = (KEY => 1) };
101 like( $@, qr/^Attempt to clear a restricted hash/ );
104 # TODO: This should be allowed but it might require putting extra
107 my %hash = (KEY => 1, RO => 2);
109 eval { %hash = (KEY => 1, RO => 2) };
110 like( $@, qr/^Attempt to clear a restricted hash/ );
117 lock_keys(%hash, qw(foo bar));
118 is( keys %hash, 0, 'lock_keys() w/keyset shouldnt add new keys' );
121 eval { $hash{wibble} = 42 };
122 like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/,
126 eval { $hash{wibble} = 23; };
127 is( $@, '', 'unlock_keys' );
132 my %hash = (foo => 42, bar => undef, baz => 0);
133 lock_keys(%hash, qw(foo bar baz up down));
134 is( keys %hash, 3, 'lock_keys() w/keyset didnt add new keys' );
135 is_deeply( \%hash, { foo => 42, bar => undef, baz => 0 } );
137 eval { $hash{up} = 42; };
140 eval { $hash{wibble} = 23 };
141 like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/, ' locked' );
146 my %hash = (foo => 42, bar => undef);
147 eval { lock_keys(%hash, qw(foo baz)); };
148 is( $@, sprintf("Hash has key 'bar' which is not in the new key ".
149 "set at %s line %d\n", __FILE__, __LINE__ - 2) );
154 my %hash = (foo => 42, bar => 23);
157 ok( Internals::SvREADONLY(%hash) );
158 ok( Internals::SvREADONLY($hash{foo}) );
159 ok( Internals::SvREADONLY($hash{bar}) );
161 unlock_hash ( %hash );
163 ok( !Internals::SvREADONLY(%hash) );
164 ok( !Internals::SvREADONLY($hash{foo}) );
165 ok( !Internals::SvREADONLY($hash{bar}) );
170 eval { () = $ENV{I_DONT_EXIST} };
171 like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/, 'locked %ENV');
176 lock_keys(%hash, 'first');
178 is (scalar keys %hash, 0, "place holder isn't a key");
180 is (scalar keys %hash, 1, "we now have a key");
182 is (scalar keys %hash, 0, "now no key");
186 $hash{interregnum} = 1.5;
187 is (scalar keys %hash, 1, "key again");
188 delete $hash{interregnum};
189 is (scalar keys %hash, 0, "no key again");
191 lock_keys(%hash, 'second');
193 is (scalar keys %hash, 0, "place holder isn't a key");
195 eval {$hash{zeroeth} = 0};
197 qr/^Attempt to access disallowed key 'zeroeth' in a restricted hash/,
198 'locked key never mentioned before should fail');
199 eval {$hash{first} = -1};
201 qr/^Attempt to access disallowed key 'first' in a restricted hash/,
202 'previously locked place holders should also fail');
203 is (scalar keys %hash, 0, "and therefore there are no keys");
205 is (scalar keys %hash, 1, "we now have just one key");
206 delete $hash{second};
207 is (scalar keys %hash, 0, "back to zero");
209 unlock_keys(%hash); # We have deliberately left a placeholder.
214 is (scalar keys %hash, 2, "two keys, values both undef");
218 is (scalar keys %hash, 2, "still two keys after locking");
220 eval {$hash{second} = -1};
222 qr/^Attempt to access disallowed key 'second' in a restricted hash/,
223 'previously locked place holders should fail');
225 is ($hash{void}, undef,
226 "undef values should not be misunderstood as placeholders");
227 is ($hash{nowt}, undef,
228 "undef values should not be misunderstood as placeholders (again)");