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