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