1use strict;
2use warnings;
3
4BEGIN {
5    use Config;
6    if (! $Config{'useithreads'}) {
7        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
8        exit(0);
9    }
10}
11
12use ExtUtils::testlib;
13
14use threads;
15
16BEGIN {
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
26my ($TEST, $COUNT, $TOTAL);
27
28BEGIN {
29    share($TEST);
30    $TEST = 1;
31    share($COUNT);
32    $COUNT = 0;
33    $TOTAL = 0;
34}
35
36ok(1, 'Loaded');
37
38sub 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
61sub foo { lock($COUNT); $COUNT++; }
62sub baz { 42 }
63
64my $bthr;
65BEGIN {
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
85my $mthr;
86MAIN: {
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
104ok($mthr, 'Main thread');
105ok($bthr, 'BEGIN thread');
106
107ok($mthr->join() == 42, 'Main join');
108ok($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
118exit(0);
119
120# EOF
121