This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
From #43633: Cwd::cwd() use in File::Spec::Unix use causes unnecessary fork()
[perl5.git] / ext / threads / t / kill.t
1 use strict;
2 use warnings;
3
4 BEGIN {
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
16 use ExtUtils::testlib;
17
18 use threads;
19
20 BEGIN {
21     eval {
22         require threads::shared;
23         import threads::shared;
24     };
25     if ($@ || ! $threads::shared::threads_shared) {
26         print("1..0 # Skip: threads::shared not available\n");
27         exit(0);
28     }
29
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     }
38
39     require Thread::Queue;
40     require Thread::Semaphore;
41
42     $| = 1;
43     print("1..18\n");   ### Number of tests that will be run ###
44 };
45
46
47 my $q = Thread::Queue->new();
48 my $TEST = 1;
49
50 sub 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         }
65     }
66 }
67
68
69 ### Start of Testing ###
70 ok(1, 'Loaded');
71
72 ### Thread cancel ###
73
74 # Set up to capture warning when thread terminates
75 my @errs :shared;
76 $SIG{__WARN__} = sub { push(@errs, @_); };
77
78 sub thr_func {
79     my $q = shift;
80
81     # Thread 'cancellation' signal handler
82     $SIG{'KILL'} = sub {
83         $q->enqueue(1, 'Thread received signal');
84         die("Thread killed\n");
85     };
86
87     # Thread sleeps until signalled
88     $q->enqueue(1, 'Thread sleeping');
89     sleep(1) for (1..10);
90     # Should not go past here
91     $q->enqueue(0, 'Thread terminated normally');
92     return ('ERROR');
93 }
94
95 # Create thread
96 my $thr = threads->create('thr_func', $q);
97 ok($thr && $thr->tid() == 2, 'Created thread');
98 threads->yield();
99 sleep(1);
100
101 # Signal thread
102 ok($thr->kill('KILL') == $thr, 'Signalled thread');
103 threads->yield();
104
105 # Cleanup
106 my $rc = $thr->join();
107 ok(! $rc, 'No thread return value');
108
109 # Check for thread termination message
110 ok(@errs && $errs[0] =~ /Thread killed/, 'Thread termination warning');
111
112
113 ### Thread suspend/resume ###
114
115 sub thr_func2
116 {
117     my $q = shift;
118
119     my $sema = shift;
120     $q->enqueue($sema, 'Thread received semaphore');
121
122     # Set up the signal handler for suspension/resumption
123     $SIG{'STOP'} = sub {
124         $q->enqueue(1, 'Thread suspending');
125         $sema->down();
126         $q->enqueue(1, 'Thread resuming');
127         $sema->up();
128     };
129
130     # Set up the signal handler for graceful termination
131     my $term = 0;
132     $SIG{'TERM'} = sub {
133         $q->enqueue(1, 'Thread caught termination signal');
134         $term = 1;
135     };
136
137     # Do work until signalled to terminate
138     while (! $term) {
139         sleep(1);
140     }
141
142     $q->enqueue(1, 'Thread done');
143     return ('OKAY');
144 }
145
146
147 # Create a semaphore for use in suspending the thread
148 my $sema = Thread::Semaphore->new();
149 ok($sema, 'Semaphore created');
150
151 # Create a thread and send it the semaphore
152 $thr = threads->create('thr_func2', $q, $sema);
153 ok($thr && $thr->tid() == 3, 'Created thread');
154 threads->yield();
155 sleep(1);
156
157 # Suspend the thread
158 $sema->down();
159 ok($thr->kill('STOP') == $thr, 'Suspended thread');
160
161 threads->yield();
162 sleep(1);
163
164 # Allow the thread to continue
165 $sema->up();
166
167 threads->yield();
168 sleep(1);
169
170 # Terminate the thread
171 ok($thr->kill('TERM') == $thr, 'Signalled thread to terminate');
172
173 $rc = $thr->join();
174 ok($rc eq 'OKAY', 'Thread return value');
175
176 ok($thr->kill('TERM') == $thr, 'Ignore signal to terminated thread');
177
178 # EOF