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