Move Thread::Semaphore from ext/ to dist/
[perl.git] / ext / threads / t / blocks.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     use Config;
6     if (! $Config{'useithreads'}) {
7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
8         exit(0);
9     }
10 }
11
12 use ExtUtils::testlib;
13
14 use threads;
15
16 BEGIN {
17     if (! eval 'use threads::shared; 1') {
18         print("1..0 # SKIP threads::shared not available\n");
19         exit(0);
20     }
21
22     $| = 1;
23     print("1..5\n");   ### Number of tests that will be run ###
24 };
25
26 my ($TEST, $COUNT, $TOTAL);
27
28 BEGIN {
29     share($TEST);
30     $TEST = 1;
31     share($COUNT);
32     $COUNT = 0;
33     $TOTAL = 0;
34 }
35
36 ok(1, 'Loaded');
37
38 sub ok {
39     my ($ok, $name) = @_;
40
41     lock($TEST);
42     my $id = $TEST++;
43
44     # You have to do it this way or VMS will get confused.
45     if ($ok) {
46         print("ok $id - $name\n");
47     } else {
48         print("not ok $id - $name\n");
49         printf("# Failed test at line %d\n", (caller)[2]);
50         print(STDERR "# FAIL: $name\n") if (! $ENV{'PERL_CORE'});
51     }
52
53     return ($ok);
54 }
55
56
57 ### Start of Testing ###
58
59 $SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); };
60
61 sub foo { lock($COUNT); $COUNT++; }
62 sub baz { 42 }
63
64 my $bthr;
65 BEGIN {
66     $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); };
67
68     $TOTAL++;
69     threads->create('foo')->join();
70     $TOTAL++;
71     threads->create(\&foo)->join();
72     $TOTAL++;
73     threads->create(sub { lock($COUNT); $COUNT++; })->join();
74
75     $TOTAL++;
76     threads->create('foo')->detach();
77     $TOTAL++;
78     threads->create(\&foo)->detach();
79     $TOTAL++;
80     threads->create(sub { lock($COUNT); $COUNT++; })->detach();
81
82     $bthr = threads->create('baz');
83 }
84
85 my $mthr;
86 MAIN: {
87     $TOTAL++;
88     threads->create('foo')->join();
89     $TOTAL++;
90     threads->create(\&foo)->join();
91     $TOTAL++;
92     threads->create(sub { lock($COUNT); $COUNT++; })->join();
93
94     $TOTAL++;
95     threads->create('foo')->detach();
96     $TOTAL++;
97     threads->create(\&foo)->detach();
98     $TOTAL++;
99     threads->create(sub { lock($COUNT); $COUNT++; })->detach();
100
101     $mthr = threads->create('baz');
102 }
103
104 ok($mthr, 'Main thread');
105 ok($bthr, 'BEGIN thread');
106
107 ok($mthr->join() == 42, 'Main join');
108 ok($bthr->join() == 42, 'BEGIN join');
109
110 # Wait for detached threads to finish
111 {
112     threads->yield();
113     sleep(1);
114     lock($COUNT);
115     redo if ($COUNT < $TOTAL);
116 }
117
118 exit(0);
119
120 # EOF