1use strict; 2use warnings; 3 4use Test::More 0.88; 5use Hash::Util::FieldHash::Compat qw(fieldhash idhash register id id_2obj idhashes fieldhashes); 6 7{ 8 my %hash = ( 9 foo => 'bar', 10 gorch => 'baz', 11 ); 12 13 fieldhash %hash; 14 15 is_deeply( \%hash, { foo => 'bar', gorch => 'baz' }, 'setting fieldhash retains values' ); 16 17 my $obj = bless {}, 'blah'; 18 19 $hash{$obj} = 'oink'; 20 21 is( scalar(keys %hash), 3, 'three keys now' ); 22 is( scalar(grep { ref } keys %hash), 0, 'no refs in the keys' ); 23 24 ok( !ref(id($obj)), 'id($obj) returns a nonref' ); 25 26 ok( exists($hash{$obj}), 'key by ref' ); 27 ok( exists($hash{id($obj)}), 'key by ref' ); 28 is( $hash{$obj}, $hash{id($obj)}, '$hash{$obj} eq $hash{id($obj)}' ); 29 30 undef $obj; 31 32 is( scalar(keys %hash), 2, '$obj key disappeared' ); 33 34 my $destroyed = 0; 35 sub zot::DESTROY { $destroyed++ }; 36 37 $obj = bless {}, "blah"; 38 39 $hash{$obj} = bless {}, "zot"; 40 41 is( $destroyed, 0, "no value destructions yet" ); 42 is( scalar(keys %hash), 3, "three keys" ); 43 44 undef $obj; 45 46 is( $destroyed, 1, "one value destroyed" ); 47 is( scalar(keys %hash), 2, "two keys in hash" ); 48} 49 50{ 51 52 idhash my %id_hash; 53 54 my $obj = bless {}, "blah"; 55 56 $id_hash{$obj} = "zoink"; 57 58 is( scalar(keys %id_hash), 1, "one key in the hash" ); 59 is_deeply([ keys %id_hash ], [ id($obj) ], "key is ID" ); 60 ok( exists($id_hash{$obj}), 'key by ref' ); 61 ok( exists($id_hash{id($obj)}), 'key by ref' ); 62 is( $id_hash{$obj}, $id_hash{id($obj)}, '$hash{$obj} eq $hash{id($obj)}' ); 63 64} 65 66{ 67 my %hash; 68 69 my $obj_1 = bless {}, "blah"; 70 my $obj_2 = bless {}, "blah"; 71 72 $hash{id($obj_1)} = "first"; 73 $hash{id($obj_2)} = "second"; 74 75 is_deeply([ sort keys %hash ], [ sort map { id($_) } $obj_1, $obj_2 ], "keys" ); 76 77 is( id_2obj(id($obj_1)), undef, "can't id_2obj yet" ); 78 is( id_2obj(id($obj_2)), undef, "can't id_2obj yet" ); 79 80 register($obj_1, \%hash); 81 82 is( id_2obj(id($obj_1)), $obj_1, "id_2obj on registered object" ); 83 is( id_2obj(id($obj_2)), undef, "can't id_2obj on unregistered object" ); 84 85 undef $obj_1; 86 undef $obj_2; 87 88 is( scalar(keys %hash), 1, "one key left" ); 89 is_deeply([ values %hash ], [qw(second)], "second object remained" ); 90} 91 92{ 93 my @id_hashes = idhashes({ foo => "bar" }, { gorch => "baz" }); 94 my @field_hashes = idhashes({ foo => "bar" }, { gorch => "baz" }); 95 96 is_deeply($_, [{ foo => "bar" }, { gorch => "baz" }], "plural form") for \@id_hashes, \@field_hashes; 97} 98 99done_testing; 100