1#!perl 2 3BEGIN { 4 if ($ENV{PERL_CORE}) { 5 chdir 't' if -d 't'; 6 @INC = '../lib'; 7 } 8} 9 10use strict; use warnings; 11use Test::More; 12my $n_tests; 13 14use Hash::Util::FieldHash qw( :all); 15my $ob_reg = Hash::Util::FieldHash::_ob_reg; 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 } 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 70BEGIN { plan tests => $n_tests } 71