Move Thread::Semaphore from ext/ to dist/
[perl.git] / ext / threads / t / kill.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     local $SIG{'HUP'} = sub {};
23     my $thr = threads->create(sub {});
24     eval { $thr->kill('HUP') };
25     $thr->join();
26     if ($@ && $@ =~ /safe signals/) {
27         print("1..0 # SKIP Not using safe signals\n");
28         exit(0);
29     }
30
31     require Thread::Queue;
32     require Thread::Semaphore;
33
34     $| = 1;
35     print("1..18\n");   ### Number of tests that will be run ###
36 };
37
38
39 my $q = Thread::Queue->new();
40 my $TEST = 1;
41
42 sub ok
43 {
44     $q->enqueue(@_);
45
46     while ($q->pending()) {
47         my $ok   = $q->dequeue();
48         my $name = $q->dequeue();
49         my $id   = $TEST++;
50
51         if ($ok) {
52             print("ok $id - $name\n");
53         } else {
54             print("not ok $id - $name\n");
55             printf("# Failed test at line %d\n", (caller)[2]);
56         }
57     }
58 }
59
60
61 ### Start of Testing ###
62 ok(1, 'Loaded');
63
64 ### Thread cancel ###
65
66 # Set up to capture warning when thread terminates
67 my @errs :shared;
68 $SIG{__WARN__} = sub { push(@errs, @_); };
69
70 sub thr_func {
71     my $q = shift;
72
73     # Thread 'cancellation' signal handler
74     $SIG{'KILL'} = sub {
75         $q->enqueue(1, 'Thread received signal');
76         die("Thread killed\n");
77     };
78
79     # Thread sleeps until signalled
80     $q->enqueue(1, 'Thread sleeping');
81     sleep(1) for (1..10);
82     # Should not go past here
83     $q->enqueue(0, 'Thread terminated normally');
84     return ('ERROR');
85 }
86
87 # Create thread
88 my $thr = threads->create('thr_func', $q);
89 ok($thr && $thr->tid() == 2, 'Created thread');
90 threads->yield();
91 sleep(1);
92
93 # Signal thread
94 ok($thr->kill('KILL') == $thr, 'Signalled thread');
95 threads->yield();
96
97 # Cleanup
98 my $rc = $thr->join();
99 ok(! $rc, 'No thread return value');
100
101 # Check for thread termination message
102 ok(@errs && $errs[0] =~ /Thread killed/, 'Thread termination warning');
103
104
105 ### Thread suspend/resume ###
106
107 sub thr_func2
108 {
109     my $q = shift;
110
111     my $sema = shift;
112     $q->enqueue($sema, 'Thread received semaphore');
113
114     # Set up the signal handler for suspension/resumption
115     $SIG{'STOP'} = sub {
116         $q->enqueue(1, 'Thread suspending');
117         $sema->down();
118         $q->enqueue(1, 'Thread resuming');
119         $sema->up();
120     };
121
122     # Set up the signal handler for graceful termination
123     my $term = 0;
124     $SIG{'TERM'} = sub {
125         $q->enqueue(1, 'Thread caught termination signal');
126         $term = 1;
127     };
128
129     # Do work until signalled to terminate
130     while (! $term) {
131         sleep(1);
132     }
133
134     $q->enqueue(1, 'Thread done');
135     return ('OKAY');
136 }
137
138
139 # Create a semaphore for use in suspending the thread
140 my $sema = Thread::Semaphore->new();
141 ok($sema, 'Semaphore created');
142
143 # Create a thread and send it the semaphore
144 $thr = threads->create('thr_func2', $q, $sema);
145 ok($thr && $thr->tid() == 3, 'Created thread');
146 threads->yield();
147 sleep(1);
148
149 # Suspend the thread
150 $sema->down();
151 ok($thr->kill('STOP') == $thr, 'Suspended thread');
152
153 threads->yield();
154 sleep(1);
155
156 # Allow the thread to continue
157 $sema->up();
158
159 threads->yield();
160 sleep(1);
161
162 # Terminate the thread
163 ok($thr->kill('TERM') == $thr, 'Signalled thread to terminate');
164
165 $rc = $thr->join();
166 ok($rc eq 'OKAY', 'Thread return value');
167
168 ok($thr->kill('TERM') == $thr, 'Ignore signal to terminated thread');
169
170 exit(0);
171
172 # EOF