1use strict;
2use warnings;
3use Test::More;
4use Config;
5
6use Hash::Util::FieldHash qw( :all);
7
8my $ob_reg = Hash::Util::FieldHash::_ob_reg;
9
10{
11    my %h;
12    fieldhash %h;
13
14    sub basic_func {
15        my $level = shift;
16        my @res;
17        my $push_is = sub {
18            my ( $hash, $should, $name) = @_;
19            push @res, [ scalar keys %$hash, $should, $name];
20        };
21
22        my $obj = [];
23        $push_is->( \ %h, 0, "$level: initially clear");
24        $push_is->( $ob_reg, 0, "$level: ob_reg initially clear");
25        $h{ $obj} = 123;
26        $push_is->( \ %h, 1, "$level: one object");
27        $push_is->( $ob_reg, 1, "$level: ob_reg one object");
28        undef $obj;
29        $push_is->( \ %h, 0, "$level: garbage collected");
30        $push_is->( $ob_reg, 0, "$level: ob_reg garbage collected");
31        @res;
32    }
33
34    &is( @$_) for basic_func( "home");
35
36    subtest 'threads' => sub {
37        plan skip_all => "No thread support" unless $Config{usethreads};
38
39        require threads;
40        my ( $t) = threads->create( \ &basic_func, "thread 1");
41        &is( @$_) for $t->join;
42
43        &is( @$_) for basic_func( "back home");
44
45        ( $t) = threads->create( sub {
46            my ( $t) = threads->create( \ &basic_func, "thread 2");
47            $t->join;
48        });
49        &is( @$_) for $t->join;
50    };
51
52    &is( @$_) for basic_func( "back home again");
53
54}
55
56done_testing();
57