This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
FieldHash coverity-compliant
[perl5.git] / ext / Hash / Util / FieldHash / t / 04_thread.t
1 #!perl
2
3 BEGIN {
4     if ($ENV{PERL_CORE}) {
5         chdir 't' if -d 't';
6         @INC = '../lib';
7     }
8 }
9
10 use strict; use warnings;
11 use Test::More;
12 my $n_tests;
13
14 use Hash::Util::FieldHash qw( :all);
15 my $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
70 BEGIN { plan tests => $n_tests }