Commit | Line | Data |
1dfe7606 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | unshift @INC, '../lib'; |
6 | } |
7 | |
8 | BEGIN{ |
9 | # Don't do anything if POSIX is missing, or sigaction missing. |
fdfddb36 |
10 | use Config; |
84251760 |
11 | eval 'use POSIX'; |
4176a672 |
12 | if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || |
e69a2255 |
13 | $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) { |
1dfe7606 |
14 | print "1..0\n"; |
15 | exit 0; |
16 | } |
17 | } |
18 | |
2317db58 |
19 | use Test::More tests => 31; |
37d19de8 |
20 | |
1dfe7606 |
21 | use strict; |
3609ea0d |
22 | use vars qw/$bad $bad7 $ok10 $bad18 $ok/; |
1dfe7606 |
23 | |
24 | $^W=1; |
25 | |
1dfe7606 |
26 | sub IGNORE { |
27 | $bad7=1; |
28 | } |
29 | |
30 | sub DEFAULT { |
31 | $bad18=1; |
32 | } |
33 | |
34 | sub foo { |
35 | $ok=1; |
36 | } |
37 | |
38 | my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0); |
39 | my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0); |
40 | |
41 | { |
42 | my $bad; |
43 | local($SIG{__WARN__})=sub { $bad=1; }; |
44 | sigaction(SIGHUP, $newaction, $oldaction); |
3609ea0d |
45 | ok(!$bad, "no warnings"); |
1dfe7606 |
46 | } |
47 | |
3609ea0d |
48 | ok($oldaction->{HANDLER} eq 'DEFAULT' || |
49 | $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER}); |
50 | |
51 | is($SIG{HUP}, '::foo'); |
1dfe7606 |
52 | |
53 | sigaction(SIGHUP, $newaction, $oldaction); |
3609ea0d |
54 | is($oldaction->{HANDLER}, '::foo'); |
55 | |
56 | ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK"); |
57 | |
58 | SKIP: { |
59 | skip("sigaction() thinks different in $^O", 1) |
60 | if $^O eq 'linux' || $^O eq 'unicos'; |
61 | is($oldaction->{FLAGS}, 0); |
1dfe7606 |
62 | } |
63 | |
64 | $newaction=POSIX::SigAction->new('IGNORE'); |
65 | sigaction(SIGHUP, $newaction); |
66 | kill 'HUP', $$; |
3609ea0d |
67 | ok(!$bad, "SIGHUP ignored"); |
1dfe7606 |
68 | |
3609ea0d |
69 | is($SIG{HUP}, 'IGNORE'); |
1dfe7606 |
70 | sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT')); |
3609ea0d |
71 | is($SIG{HUP}, 'DEFAULT'); |
1dfe7606 |
72 | |
73 | $newaction=POSIX::SigAction->new(sub { $ok10=1; }); |
74 | sigaction(SIGHUP, $newaction); |
75 | { |
76 | local($^W)=0; |
77 | kill 'HUP', $$; |
78 | } |
3609ea0d |
79 | ok($ok10, "SIGHUP handler called"); |
1dfe7606 |
80 | |
3609ea0d |
81 | is(ref($SIG{HUP}), 'CODE'); |
1dfe7606 |
82 | |
83 | sigaction(SIGHUP, POSIX::SigAction->new('::foo')); |
84 | # Make sure the signal mask gets restored after sigaction croak()s. |
85 | eval { |
86 | my $act=POSIX::SigAction->new('::foo'); |
87 | delete $act->{HANDLER}; |
88 | sigaction(SIGINT, $act); |
89 | }; |
90 | kill 'HUP', $$; |
3609ea0d |
91 | ok($ok, "signal mask gets restored after croak"); |
1dfe7606 |
92 | |
93 | undef $ok; |
94 | # Make sure the signal mask gets restored after sigaction returns early. |
95 | my $x=defined sigaction(SIGKILL, $newaction, $oldaction); |
96 | kill 'HUP', $$; |
3609ea0d |
97 | ok(!$x && $ok, "signal mask gets restored after early return"); |
1dfe7606 |
98 | |
99 | $SIG{HUP}=sub {}; |
100 | sigaction(SIGHUP, $newaction, $oldaction); |
3609ea0d |
101 | is(ref($oldaction->{HANDLER}), 'CODE'); |
1dfe7606 |
102 | |
103 | eval { |
104 | sigaction(SIGHUP, undef, $oldaction); |
105 | }; |
3609ea0d |
106 | ok(!$@, "undef for new action"); |
1dfe7606 |
107 | |
108 | eval { |
109 | sigaction(SIGHUP, 0, $oldaction); |
110 | }; |
3609ea0d |
111 | ok(!$@, "zero for new action"); |
1dfe7606 |
112 | |
113 | eval { |
114 | sigaction(SIGHUP, bless({},'Class'), $oldaction); |
115 | }; |
3609ea0d |
116 | ok($@, "any object not good as new action"); |
1dfe7606 |
117 | |
3609ea0d |
118 | SKIP: { |
119 | skip("SIGCONT not trappable in $^O", 1) |
120 | if ($^O eq 'VMS'); |
f6a06849 |
121 | $newaction=POSIX::SigAction->new(sub { $ok10=1; }); |
122 | if (eval { SIGCONT; 1 }) { |
123 | sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT')); |
124 | { |
125 | local($^W)=0; |
126 | kill 'CONT', $$; |
127 | } |
4f0c37ba |
128 | } |
3609ea0d |
129 | ok(!$bad18, "SIGCONT trappable"); |
1dfe7606 |
130 | } |
1dfe7606 |
131 | |
1d81eac9 |
132 | { |
133 | local $SIG{__WARN__} = sub { }; # Just suffer silently. |
134 | |
135 | my $hup20; |
136 | my $hup21; |
137 | |
138 | sub hup20 { $hup20++ } |
139 | sub hup21 { $hup21++ } |
140 | |
141 | sigaction("FOOBAR", $newaction); |
3609ea0d |
142 | ok(1, "no coredump, still alive"); |
1d81eac9 |
143 | |
144 | $newaction = POSIX::SigAction->new("hup20"); |
145 | sigaction("SIGHUP", $newaction); |
146 | kill "HUP", $$; |
3609ea0d |
147 | is($hup20, 1); |
1d81eac9 |
148 | |
149 | $newaction = POSIX::SigAction->new("hup21"); |
150 | sigaction("HUP", $newaction); |
151 | kill "HUP", $$; |
3609ea0d |
152 | is ($hup21, 1); |
1d81eac9 |
153 | } |
d36b6582 |
154 | |
155 | # "safe" attribute. |
156 | # for this one, use the accessor instead of the attribute |
157 | |
158 | # standard signal handling via %SIG is safe |
159 | $SIG{HUP} = \&foo; |
160 | $oldaction = POSIX::SigAction->new; |
161 | sigaction(SIGHUP, undef, $oldaction); |
3609ea0d |
162 | ok($oldaction->safe, "SIGHUP is safe"); |
d36b6582 |
163 | |
164 | # SigAction handling is not safe ... |
165 | sigaction(SIGHUP, POSIX::SigAction->new(\&foo)); |
166 | sigaction(SIGHUP, undef, $oldaction); |
3609ea0d |
167 | ok(!$oldaction->safe, "SigAction not safe by default"); |
d36b6582 |
168 | |
169 | # ... unless we say so! |
170 | $newaction = POSIX::SigAction->new(\&foo); |
171 | $newaction->safe(1); |
172 | sigaction(SIGHUP, $newaction); |
173 | sigaction(SIGHUP, undef, $oldaction); |
3609ea0d |
174 | ok($oldaction->safe, "SigAction can be safe"); |
d36b6582 |
175 | |
176 | # And safe signal delivery must work |
177 | $ok = 0; |
178 | kill 'HUP', $$; |
3609ea0d |
179 | ok($ok, "safe signal delivery must work"); |
180 | |
181 | SKIP: { |
8d13d857 |
182 | eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX); scalar %SIGRT + SIGRTMIN() + SIGRTMAX()'; |
ba822478 |
183 | $@ # POSIX did not exort |
184 | || SIGRTMIN() < 0 || SIGRTMAX() < 0 # HP-UX 10.20 exports both as -1 |
185 | || SIGRTMIN() > $Config{sig_count} # AIX 4.3.3 exports bogus 888 and 999 |
186 | and skip("no SIGRT signals", 4); |
8bdc704b |
187 | ok(SIGRTMAX() > SIGRTMIN(), "SIGRTMAX > SIGRTMIN"); |
3609ea0d |
188 | is(scalar %SIGRT, SIGRTMAX() - SIGRTMIN() + 1, "scalar SIGRT"); |
189 | my $sigrtmin; |
190 | my $h = sub { $sigrtmin = 1 }; |
191 | $SIGRT{SIGRTMIN} = $h; |
192 | is($SIGRT{SIGRTMIN}, $h, "handler set & get"); |
193 | kill 'SIGRTMIN', $$; |
194 | is($sigrtmin, 1, "SIGRTMIN handler works"); |
195 | } |
8aad04aa |
196 | |
197 | SKIP: { |
198 | eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO'; |
199 | skip("no SA_SIGINFO", 1) if $@; |
200 | sub hiphup { |
08120247 |
201 | is($_[1]->{signo}, SIGHUP, "SA_SIGINFO got right signal"); |
8aad04aa |
202 | } |
203 | my $act = POSIX::SigAction->new('hiphup', 0, SA_SIGINFO); |
204 | sigaction(SIGHUP, $act); |
205 | kill 'HUP', $$; |
206 | } |
207 | |
516d25e8 |
208 | eval { sigaction(-999, "foo"); }; |
209 | like($@, qr/Negative signals/, |
210 | "Prevent negative signals instead of core dumping"); |