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