Commit | Line | Data |
49293501 |
1 | #!/usr/bin/perl -Tw |
2 | |
3 | BEGIN { |
4 | if( $ENV{PERL_CORE} ) { |
5 | @INC = '../lib'; |
6 | chdir 't'; |
7 | } |
8 | } |
dfd4ef2f |
9 | use Test::More tests => 55; |
49293501 |
10 | |
11 | my @Exported_Funcs; |
12 | BEGIN { |
13 | @Exported_Funcs = qw(lock_keys unlock_keys |
14 | lock_value unlock_value |
15 | lock_hash unlock_hash |
16 | ); |
17 | use_ok 'Hash::Util', @Exported_Funcs; |
18 | } |
19 | foreach my $func (@Exported_Funcs) { |
20 | can_ok __PACKAGE__, $func; |
21 | } |
22 | |
23 | my %hash = (foo => 42, bar => 23, locked => 'yep'); |
24 | lock_keys(%hash); |
25 | eval { $hash{baz} = 99; }; |
2393f1b9 |
26 | like( $@, qr/^Attempt to access disallowed key 'baz' in a restricted hash/, |
49293501 |
27 | 'lock_keys()'); |
28 | is( $hash{bar}, 23 ); |
29 | ok( !exists $hash{baz} ); |
30 | |
31 | delete $hash{bar}; |
32 | ok( !exists $hash{bar} ); |
33 | $hash{bar} = 69; |
34 | is( $hash{bar}, 69 ); |
35 | |
36 | eval { () = $hash{i_dont_exist} }; |
2393f1b9 |
37 | like( $@, qr/^Attempt to access disallowed key 'i_dont_exist' in a restricted hash/ ); |
49293501 |
38 | |
39 | lock_value(%hash, 'locked'); |
40 | eval { print "# oops" if $hash{four} }; |
2393f1b9 |
41 | like( $@, qr/^Attempt to access disallowed key 'four' in a restricted hash/ ); |
49293501 |
42 | |
43 | eval { $hash{"\x{2323}"} = 3 }; |
2393f1b9 |
44 | like( $@, qr/^Attempt to access disallowed key '(.*)' in a restricted hash/, |
49293501 |
45 | 'wide hex key' ); |
46 | |
47 | eval { delete $hash{locked} }; |
2393f1b9 |
48 | like( $@, qr/^Attempt to delete readonly key 'locked' from a restricted hash/, |
49293501 |
49 | 'trying to delete a locked key' ); |
50 | eval { $hash{locked} = 42; }; |
51 | like( $@, qr/^Modification of a read-only value attempted/, |
52 | 'trying to change a locked key' ); |
53 | is( $hash{locked}, 'yep' ); |
54 | |
55 | eval { delete $hash{I_dont_exist} }; |
2393f1b9 |
56 | like( $@, qr/^Attempt to delete disallowed key 'I_dont_exist' from a restricted hash/, |
49293501 |
57 | 'trying to delete a key that doesnt exist' ); |
58 | |
59 | ok( !exists $hash{I_dont_exist} ); |
60 | |
61 | unlock_keys(%hash); |
62 | $hash{I_dont_exist} = 42; |
63 | is( $hash{I_dont_exist}, 42, 'unlock_keys' ); |
64 | |
65 | eval { $hash{locked} = 42; }; |
66 | like( $@, qr/^Modification of a read-only value attempted/, |
67 | ' individual key still readonly' ); |
68 | eval { delete $hash{locked} }, |
69 | is( $@, '', ' but can be deleted :(' ); |
70 | |
71 | unlock_value(%hash, 'locked'); |
72 | $hash{locked} = 42; |
73 | is( $hash{locked}, 42, 'unlock_value' ); |
74 | |
75 | |
76 | TODO: { |
77 | # local $TODO = 'assigning to a hash screws with locked keys'; |
78 | |
79 | my %hash = ( foo => 42, locked => 23 ); |
80 | |
81 | lock_keys(%hash); |
82 | lock_value(%hash, 'locked'); |
83 | eval { %hash = ( wubble => 42 ) }; # we know this will bomb |
2393f1b9 |
84 | like( $@, qr/^Attempt to clear a restricted hash/ ); |
49293501 |
85 | |
86 | eval { unlock_value(%hash, 'locked') }; # but this shouldn't |
87 | is( $@, '', 'unlock_value() after denied assignment' ); |
88 | |
89 | is_deeply( \%hash, { foo => 42, locked => 23 }, |
90 | 'hash should not be altered by denied assignment' ); |
91 | unlock_keys(%hash); |
92 | } |
93 | |
94 | { |
95 | my %hash = (KEY => 'val', RO => 'val'); |
96 | lock_keys(%hash); |
97 | lock_value(%hash, 'RO'); |
98 | |
99 | eval { %hash = (KEY => 1) }; |
2393f1b9 |
100 | like( $@, qr/^Attempt to clear a restricted hash/ ); |
49293501 |
101 | } |
102 | |
103 | # TODO: This should be allowed but it might require putting extra |
104 | # code into aassign. |
105 | { |
106 | my %hash = (KEY => 1, RO => 2); |
107 | lock_keys(%hash); |
108 | eval { %hash = (KEY => 1, RO => 2) }; |
2393f1b9 |
109 | like( $@, qr/^Attempt to clear a restricted hash/ ); |
49293501 |
110 | } |
111 | |
112 | |
113 | |
114 | { |
115 | my %hash = (); |
116 | lock_keys(%hash, qw(foo bar)); |
117 | is( keys %hash, 0, 'lock_keys() w/keyset shouldnt add new keys' ); |
118 | $hash{foo} = 42; |
119 | is( keys %hash, 1 ); |
120 | eval { $hash{wibble} = 42 }; |
2393f1b9 |
121 | like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/, |
49293501 |
122 | ' locked'); |
123 | |
124 | unlock_keys(%hash); |
125 | eval { $hash{wibble} = 23; }; |
126 | is( $@, '', 'unlock_keys' ); |
127 | } |
128 | |
129 | |
130 | { |
131 | my %hash = (foo => 42, bar => undef, baz => 0); |
132 | lock_keys(%hash, qw(foo bar baz up down)); |
133 | is( keys %hash, 3, 'lock_keys() w/keyset didnt add new keys' ); |
134 | is_deeply( \%hash, { foo => 42, bar => undef, baz => 0 } ); |
135 | |
136 | eval { $hash{up} = 42; }; |
137 | is( $@, '' ); |
138 | |
139 | eval { $hash{wibble} = 23 }; |
2393f1b9 |
140 | like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/, ' locked' ); |
49293501 |
141 | } |
142 | |
143 | |
144 | { |
145 | my %hash = (foo => 42, bar => undef); |
146 | eval { lock_keys(%hash, qw(foo baz)); }; |
147 | is( $@, sprintf("Hash has key 'bar' which is not in the new key ". |
148 | "set at %s line %d\n", __FILE__, __LINE__ - 2) ); |
149 | } |
150 | |
151 | |
152 | { |
153 | my %hash = (foo => 42, bar => 23); |
154 | lock_hash( %hash ); |
155 | |
29569577 |
156 | ok( Internals::SvREADONLY(%hash) ); |
157 | ok( Internals::SvREADONLY($hash{foo}) ); |
158 | ok( Internals::SvREADONLY($hash{bar}) ); |
49293501 |
159 | |
160 | unlock_hash ( %hash ); |
161 | |
29569577 |
162 | ok( !Internals::SvREADONLY(%hash) ); |
163 | ok( !Internals::SvREADONLY($hash{foo}) ); |
164 | ok( !Internals::SvREADONLY($hash{bar}) ); |
49293501 |
165 | } |
166 | |
167 | |
168 | lock_keys(%ENV); |
169 | eval { () = $ENV{I_DONT_EXIST} }; |
2393f1b9 |
170 | like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/, 'locked %ENV'); |
dfd4ef2f |
171 | |
172 | { |
173 | my %hash; |
174 | |
175 | lock_keys(%hash, 'first'); |
176 | |
177 | is (scalar keys %hash, 0, "place holder isn't a key"); |
178 | $hash{first} = 1; |
179 | is (scalar keys %hash, 1, "we now have a key"); |
180 | delete $hash{first}; |
181 | is (scalar keys %hash, 0, "now no key"); |
182 | |
183 | unlock_keys(%hash); |
184 | |
185 | $hash{interregnum} = 1.5; |
186 | is (scalar keys %hash, 1, "key again"); |
187 | delete $hash{interregnum}; |
188 | is (scalar keys %hash, 0, "no key again"); |
189 | |
190 | lock_keys(%hash, 'second'); |
191 | |
192 | is (scalar keys %hash, 0, "place holder isn't a key"); |
193 | |
194 | eval {$hash{zeroeth} = 0}; |
195 | like ($@, |
196 | qr/^Attempt to access disallowed key 'zeroeth' in a restricted hash/, |
197 | 'locked key never mentioned before should fail'); |
198 | eval {$hash{first} = -1}; |
199 | like ($@, |
200 | qr/^Attempt to access disallowed key 'first' in a restricted hash/, |
201 | 'previously locked place holders should also fail'); |
202 | is (scalar keys %hash, 0, "and therefore there are no keys"); |
203 | $hash{second} = 1; |
204 | is (scalar keys %hash, 1, "we now have just one key"); |
205 | } |