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 threads::shared->import();
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");
39 require Thread::Queue;
40 require Thread::Semaphore;
43 print("1..18\n"); ### Number of tests that will be run ###
47 my $q = Thread::Queue->new();
54 while ($q->pending()) {
55 my $ok = $q->dequeue();
56 my $name = $q->dequeue();
60 print("ok $id - $name\n");
62 print("not ok $id - $name\n");
63 printf("# Failed test at line %d\n", (caller)[2]);
69 ### Start of Testing ###
74 # Set up to capture warning when thread terminates
76 $SIG{__WARN__} = sub { push(@errs, @_); };
81 # Thread 'cancellation' signal handler
83 $q->enqueue(1, 'Thread received signal');
84 die("Thread killed\n");
87 # Thread sleeps until signalled
88 $q->enqueue(1, 'Thread sleeping');
90 # Should not go past here
91 $q->enqueue(0, 'Thread terminated normally');
96 my $thr = threads->create('thr_func', $q);
97 ok($thr && $thr->tid() == 2, 'Created thread');
102 ok($thr->kill('KILL') == $thr, 'Signalled thread');
106 my $rc = $thr->join();
107 ok(! $rc, 'No thread return value');
109 # Check for thread termination message
110 ok(@errs && $errs[0] =~ /Thread killed/, 'Thread termination warning');
113 ### Thread suspend/resume ###
120 $q->enqueue($sema, 'Thread received semaphore');
122 # Set up the signal handler for suspension/resumption
124 $q->enqueue(1, 'Thread suspending');
126 $q->enqueue(1, 'Thread resuming');
130 # Set up the signal handler for graceful termination
133 $q->enqueue(1, 'Thread caught termination signal');
137 # Do work until signalled to terminate
142 $q->enqueue(1, 'Thread done');
147 # Create a semaphore for use in suspending the thread
148 my $sema = Thread::Semaphore->new();
149 ok($sema, 'Semaphore created');
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');
159 ok($thr->kill('STOP') == $thr, 'Suspended thread');
164 # Allow the thread to continue
170 # Terminate the thread
171 ok($thr->kill('TERM') == $thr, 'Signalled thread to terminate');
174 ok($rc eq 'OKAY', 'Thread return value');
176 ok($thr->kill('TERM') == $thr, 'Ignore signal to terminated thread');