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