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