ext/Hash-Util-FieldHash/t/04_thread.t

   1 #!perl
   2 use strict; use warnings;
   3 use Test::More;
   4 my $n_tests;
   5
   6 use Hash::Util::FieldHash qw( :all);
   7 my $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
  62 BEGIN { plan tests => $n_tests }