chdir 't';
}
}
-use Test::More tests => 157;
+use Test::More tests => 173;
use strict;
my @Exported_Funcs;
@Exported_Funcs = qw(lock_keys unlock_keys
lock_value unlock_value
lock_hash unlock_hash
+ hash_seed
);
use_ok 'Hash::Util', @Exported_Funcs;
}
is( $hash{locked}, 42, 'unlock_value' );
-TODO: {
-# local $TODO = 'assigning to a hash screws with locked keys';
-
+{
my %hash = ( foo => 42, locked => 23 );
lock_keys(%hash);
- lock_value(%hash, 'locked');
eval { %hash = ( wubble => 42 ) }; # we know this will bomb
- like( $@, qr/^Attempt to clear a restricted hash/ );
-
- eval { unlock_value(%hash, 'locked') }; # but this shouldn't
- is( $@, '', 'unlock_value() after denied assignment' );
-
- is_deeply( \%hash, { foo => 42, locked => 23 },
- 'hash should not be altered by denied assignment' );
+ like( $@, qr/^Attempt to access disallowed key 'wubble'/ );
unlock_keys(%hash);
}
lock_value(%hash, 'RO');
eval { %hash = (KEY => 1) };
- like( $@, qr/^Attempt to clear a restricted hash/ );
+ like( $@, qr/^Attempt to delete readonly key 'RO' from a restricted hash/ );
}
-# TODO: This should be allowed but it might require putting extra
-# code into aassign.
{
my %hash = (KEY => 1, RO => 2);
lock_keys(%hash);
eval { %hash = (KEY => 1, RO => 2) };
- like( $@, qr/^Attempt to clear a restricted hash/ );
+ is( $@, '');
}
}
}
}
+
+# Check clear works on locked empty hashes - SEGVs on 5.8.2.
+{
+ my %hash;
+ lock_hash(%hash);
+ %hash = ();
+ ok(keys(%hash) == 0, 'clear empty lock_hash() hash');
+}
+{
+ my %hash;
+ lock_keys(%hash);
+ %hash = ();
+ ok(keys(%hash) == 0, 'clear empty lock_keys() hash');
+}
+
+my $hash_seed = hash_seed();
+ok($hash_seed >= 0, "hash_seed $hash_seed");
+
+{
+ package Minder;
+ my $counter;
+ sub DESTROY {
+ --$counter;
+ }
+ sub new {
+ ++$counter;
+ bless [], __PACKAGE__;
+ }
+ package main;
+
+ for my $state ('', 'locked') {
+ my $a = Minder->new();
+ is ($counter, 1, "There is 1 object $state");
+ my %hash;
+ $hash{a} = $a;
+ is ($counter, 1, "There is still 1 object $state");
+
+ lock_keys(%hash) if $state;
+
+ is ($counter, 1, "There is still 1 object $state");
+ undef $a;
+ is ($counter, 1, "Still 1 object $state");
+ delete $hash{a};
+ is ($counter, 0, "0 objects when hash key is deleted $state");
+ $hash{a} = undef;
+ is ($counter, 0, "Still 0 objects $state");
+ %hash = ();
+ is ($counter, 0, "0 objects after clear $state");
+ }
+}