xref: /openbsd/gnu/usr.bin/perl/dist/threads/t/kill.t (revision f6aab3d8) 
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    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
39my $q = Thread::Queue->new();
40my $TEST = 1;
41
42sub 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 ###
62ok(1, 'Loaded');
63
64### Thread cancel ###
65
66# Set up to capture warning when thread terminates
67my @errs :shared;
68$SIG{__WARN__} = sub { push(@errs, @_); };
69
70sub 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
88my $thr = threads->create('thr_func', $q);
89ok($thr && $thr->tid() == 2, 'Created thread');
90threads->yield();
91sleep(1);
92
93# Signal thread
94ok($thr->kill('KILL') == $thr, 'Signalled thread');
95threads->yield();
96
97# Cleanup
98my $rc = $thr->join();
99ok(! $rc, 'No thread return value');
100
101# Check for thread termination message
102ok(@errs && $errs[0] =~ /Thread killed/, 'Thread termination warning');
103
104
105### Thread suspend/resume ###
106
107sub 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
140my $sema = Thread::Semaphore->new();
141ok($sema, 'Semaphore created');
142
143# Create a thread and send it the semaphore
144$thr = threads->create('thr_func2', $q, $sema);
145ok($thr && $thr->tid() == 3, 'Created thread');
146threads->yield();
147sleep(1);
148
149# Suspend the thread
150$sema->down();
151ok($thr->kill('STOP') == $thr, 'Suspended thread');
152
153threads->yield();
154sleep(1);
155
156# Allow the thread to continue
157$sema->up();
158
159threads->yield();
160sleep(1);
161
162# Terminate the thread
163ok($thr->kill('TERM') == $thr, 'Signalled thread to terminate');
164
165$rc = $thr->join();
166ok($rc eq 'OKAY', 'Thread return value');
167
168ok($thr->kill('TERM') == $thr, 'Ignore signal to terminated thread');
169
170exit(0);
171
172# EOF
173