1use strict; 2use warnings; 3 4BEGIN { 5 require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); 6 7 use Config; 8 if (! $Config{'useithreads'}) { 9 skip_all(q/Perl not compiled with 'useithreads'/); 10 } 11} 12 13use ExtUtils::testlib; 14 15use threads; 16 17BEGIN { 18 if (! eval 'use threads::shared; 1') { 19 skip_all('threads::shared not available'); 20 } 21 22 local $SIG{'HUP'} = sub {}; 23 my $thr = threads->create(sub {}); 24 eval { $thr->kill('HUP') }; 25 $thr->join(); 26 if ($@ && $@ =~ /safe signals/) { 27 skip_all('Not using safe signals'); 28 } 29 30 plan(4); 31}; 32 33fresh_perl_is(<<'EOI', 'ok', { }, 'No signal handler in thread'); 34 use threads; 35 use Thread::Semaphore; 36 my $sema = Thread::Semaphore->new(0); 37 my $test = sub { 38 my $sema = shift; 39 $sema->up(); 40 while(1) { sleep(1); } 41 }; 42 my $thr = threads->create($test, $sema); 43 $sema->down(); 44 $thr->detach(); 45 eval { 46 $thr->kill('STOP'); 47 }; 48 print(($@ =~ /no signal handler set/) ? 'ok' : 'not ok'); 49EOI 50 51fresh_perl_is(<<'EOI', 'ok', { }, 'Handler to signal mismatch'); 52 use threads; 53 use Thread::Semaphore; 54 my $sema = Thread::Semaphore->new(0); 55 my $test = sub { 56 my $sema = shift; 57 $SIG{'TERM'} = sub { threads->exit() }; 58 $sema->up(); 59 while(1) { sleep(1); } 60 }; 61 my $thr = threads->create($test, $sema); 62 $sema->down(); 63 $thr->detach(); 64 eval { 65 $thr->kill('STOP'); 66 }; 67 print(($@ =~ /no signal handler set/) ? 'ok' : 'not ok'); 68EOI 69 70fresh_perl_is(<<'EOI', 'ok', { }, 'Handler and signal match'); 71 use threads; 72 use Thread::Semaphore; 73 my $sema = Thread::Semaphore->new(0); 74 my $test = sub { 75 my $sema = shift; 76 $SIG{'STOP'} = sub { threads->exit() }; 77 $sema->up(); 78 while(1) { sleep(1); } 79 }; 80 my $thr = threads->create($test, $sema); 81 $sema->down(); 82 $thr->detach(); 83 eval { 84 $thr->kill('STOP'); 85 }; 86 print((! $@) ? 'ok' : 'not ok'); 87EOI 88 89fresh_perl_is(<<'EOI', 'ok', { }, 'Ignore signal after thread finishes'); 90 use threads; 91 92 my $thr = threads->create(sub { 93 $SIG{KILL} = sub { 94 threads->exit(); 95 }; 96 return 0; 97 }); 98 99 until ($thr->is_joinable()) { 100 threads->yield(); 101 } 102 103 $thr->kill('SIGKILL'); 104 $thr->join(); 105 print((! $@) ? 'ok' : 'not ok'); 106EOI 107 108exit(0); 109 110# EOF 111