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