5 if ($ENV{'PERL_CORE'}){
7 unshift @INC, '../lib';
10 if (! $Config{'useithreads'}) {
11 print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
16 use ExtUtils::testlib;
22 require threads::shared;
23 import threads::shared;
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # Skip: threads::shared not available\n");
30 local $SIG{'HUP'} = sub {};
31 my $thr = threads->create(sub {});
32 eval { $thr->kill('HUP') };
34 if ($@ && $@ =~ /safe signals/) {
35 print("1..0 # Skip: Not using safe signals\n");
41 package Thread::Semaphore;
46 my $val : shared = @_ ? shift : 1;
53 my $inc = @_ ? shift : 1;
54 cond_wait $$s until $$s >= $inc;
61 my $inc = @_ ? shift : 1;
62 ($$s += $inc) > 0 and cond_broadcast $$s;
68 print("1..19\n"); ### Number of tests that will be run ###
82 # You have to do it this way or VMS will get confused.
84 print("ok $id - $name\n");
86 print("not ok $id - $name\n");
87 printf("# Failed test at line %d\n", (caller)[2]);
94 ### Start of Testing ###
98 # Set up to capture warning when thread terminates
100 $SIG{__WARN__} = sub { push(@errs, @_); };
104 # Thread 'cancellation' signal handler
106 ok(1, 'Thread received signal');
107 die("Thread killed\n");
110 # Thread sleeps until signalled
111 ok(1, 'Thread sleeping');
113 local $SIG{'INT'} = sub {};
116 # Should not go past here
117 ok(0, 'Thread terminated normally');
123 my $thr = threads->create('thr_func');
124 ok($thr && $thr->tid() == 2, 'Created thread');
129 ok($thr->kill('KILL'), 'Signalled thread');
132 # Interrupt thread's sleep call
134 # We can't be sure whether the signal itself will get delivered to this
135 # thread or the sleeping thread
136 local $SIG{'INT'} = sub {};
137 ok(kill('INT', $$) || $^O eq 'MSWin32', q/Interrupt thread's sleep call/);
141 my $rc = $thr->join();
142 ok(! $rc, 'No thread return value');
144 # Check for thread termination message
145 ok(@errs && $errs[0] =~ /Thread killed/, 'Thread termination warning');
148 ### Thread suspend/resume ###
153 ok($sema, 'Thread received semaphore');
155 # Set up the signal handler for suspension/resumption
157 ok(1, 'Thread suspending');
159 ok(1, 'Thread resuming');
163 # Set up the signal handler for graceful termination
166 ok(1, 'Thread caught termination signal');
170 # Do work until signalled to terminate
175 ok(1, 'Thread done');
180 # Create a semaphore for use in suspending the thread
181 my $sema = Thread::Semaphore->new();
182 ok($sema, 'Semaphore created');
184 # Create a thread and send it the semaphore
185 $thr = threads->create('thr_func2', $sema);
186 ok($thr && $thr->tid() == 3, 'Created thread');
192 ok($thr->kill('STOP'), 'Suspended thread');
197 # Allow the thread to continue
203 # Terminate the thread
204 ok($thr->kill('TERM') == $thr, 'Signalled thread to terminate');
207 ok($rc eq 'OKAY', 'Thread return value');
209 ok($thr->kill('TERM'), 'Ignore signal to terminated thread');