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