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
CommitLineData
f2e0bb91
JH
1use strict;
2use warnings;
3
4BEGIN {
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
16use ExtUtils::testlib;
17
18use threads;
f2e0bb91 19
f2e0bb91 20BEGIN {
58a3a76c
JH
21 eval {
22 require threads::shared;
f3086ff0 23 threads::shared->import();
58a3a76c
JH
24 };
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # Skip: threads::shared not available\n");
27 exit(0);
28 }
29
f2e0bb91
JH
30 $| = 1;
31 print("1..5\n"); ### Number of tests that will be run ###
f2e0bb91
JH
32};
33
4dcb9e53
JH
34my ($TEST, $COUNT, $TOTAL);
35
36BEGIN {
37 share($TEST);
38 $TEST = 1;
39 share($COUNT);
40 $COUNT = 0;
41 $TOTAL = 0;
42}
58a3a76c 43
f2e0bb91
JH
44ok(1, 'Loaded');
45
46sub 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]);
4dcb9e53 58 print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
f2e0bb91
JH
59 }
60
61 return ($ok);
62}
63
64
65### Start of Testing ###
66
67$SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); };
68
4dcb9e53 69sub foo { lock($COUNT); $COUNT++; }
f2e0bb91
JH
70sub baz { 42 }
71
72my $bthr;
73BEGIN {
74 $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); };
75
4dcb9e53 76 $TOTAL++;
f2e0bb91 77 threads->create('foo')->join();
4dcb9e53 78 $TOTAL++;
f2e0bb91 79 threads->create(\&foo)->join();
4dcb9e53
JH
80 $TOTAL++;
81 threads->create(sub { lock($COUNT); $COUNT++; })->join();
f2e0bb91 82
4dcb9e53 83 $TOTAL++;
f2e0bb91 84 threads->create('foo')->detach();
4dcb9e53 85 $TOTAL++;
f2e0bb91 86 threads->create(\&foo)->detach();
4dcb9e53
JH
87 $TOTAL++;
88 threads->create(sub { lock($COUNT); $COUNT++; })->detach();
f2e0bb91
JH
89
90 $bthr = threads->create('baz');
91}
92
93my $mthr;
94MAIN: {
4dcb9e53 95 $TOTAL++;
f2e0bb91 96 threads->create('foo')->join();
4dcb9e53 97 $TOTAL++;
f2e0bb91 98 threads->create(\&foo)->join();
4dcb9e53
JH
99 $TOTAL++;
100 threads->create(sub { lock($COUNT); $COUNT++; })->join();
f2e0bb91 101
4dcb9e53 102 $TOTAL++;
f2e0bb91 103 threads->create('foo')->detach();
4dcb9e53 104 $TOTAL++;
f2e0bb91 105 threads->create(\&foo)->detach();
4dcb9e53
JH
106 $TOTAL++;
107 threads->create(sub { lock($COUNT); $COUNT++; })->detach();
f2e0bb91
JH
108
109 $mthr = threads->create('baz');
110}
111
112ok($mthr, 'Main thread');
113ok($bthr, 'BEGIN thread');
114
115ok($mthr->join() == 42, 'Main join');
116ok($bthr->join() == 42, 'BEGIN join');
117
4dcb9e53
JH
118# Wait for detached threads to finish
119{
120 threads->yield();
121 sleep(1);
122 lock($COUNT);
123 redo if ($COUNT < $TOTAL);
124}
5168baf3 125
4dcb9e53 126# EOF