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