Commit | Line | Data |
---|---|---|
1dfe7606 AJ |
1 | #!./perl |
2 | ||
1dfe7606 AJ |
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 AJ |
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 AJ |
18 | |
19 | $^W=1; | |
20 | ||
1dfe7606 AJ |
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 AJ |
41 | } |
42 | ||
3609ea0d JH |
43 | ok($oldaction->{HANDLER} eq 'DEFAULT' || |
44 | $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER}); | |
45 | ||
46 | is($SIG{HUP}, '::foo'); | |
1dfe7606 AJ |
47 | |
48 | sigaction(SIGHUP, $newaction, $oldaction); | |
3609ea0d JH |
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 AJ |
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 AJ |
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 AJ |
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 AJ |
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 AJ |
93 | |
94 | $SIG{HUP}=sub {}; | |
95 | sigaction(SIGHUP, $newaction, $oldaction); | |
3609ea0d | 96 | is(ref($oldaction->{HANDLER}), 'CODE'); |
1dfe7606 AJ |
97 | |
98 | eval { | |
99 | sigaction(SIGHUP, undef, $oldaction); | |
100 | }; | |
3609ea0d | 101 | ok(!$@, "undef for new action"); |
1dfe7606 AJ |
102 | |
103 | eval { | |
104 | sigaction(SIGHUP, 0, $oldaction); | |
105 | }; | |
3609ea0d | 106 | ok(!$@, "zero for new action"); |
1dfe7606 AJ |
107 | |
108 | eval { | |
109 | sigaction(SIGHUP, bless({},'Class'), $oldaction); | |
110 | }; | |
3609ea0d | 111 | ok($@, "any object not good as new action"); |
1dfe7606 | 112 | |
3609ea0d JH |
113 | SKIP: { |
114 | skip("SIGCONT not trappable in $^O", 1) | |
115 | if ($^O eq 'VMS'); | |
f6a06849 JH |
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 JH |
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 JH |
138 | |
139 | $newaction = POSIX::SigAction->new("hup20"); | |
140 | sigaction("SIGHUP", $newaction); | |
141 | kill "HUP", $$; | |
3609ea0d | 142 | is($hup20, 1); |
1d81eac9 JH |
143 | |
144 | $newaction = POSIX::SigAction->new("hup21"); | |
145 | sigaction("HUP", $newaction); | |
146 | kill "HUP", $$; | |
3609ea0d | 147 | is ($hup21, 1); |
1d81eac9 | 148 | } |
d36b6582 CS |
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 CS |
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 CS |
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 CS |
170 | |
171 | # And safe signal delivery must work | |
172 | $ok = 0; | |
173 | kill 'HUP', $$; | |
3609ea0d JH |
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 MB |
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 JH |
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 JH |
191 | |
192 | SKIP: { | |
193 | eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO'; | |
194 | skip("no SA_SIGINFO", 1) if $@; | |
4f1623e5 | 195 | skip("SA_SIGINFO is broken on AIX 4.2", 1) if $^O.$Config{osvers} =~ m/^aix4\.2/; |
8aad04aa | 196 | sub hiphup { |
08120247 | 197 | is($_[1]->{signo}, SIGHUP, "SA_SIGINFO got right signal"); |
8aad04aa JH |
198 | } |
199 | my $act = POSIX::SigAction->new('hiphup', 0, SA_SIGINFO); | |
200 | sigaction(SIGHUP, $act); | |
201 | kill 'HUP', $$; | |
202 | } | |
203 | ||
516d25e8 SP |
204 | eval { sigaction(-999, "foo"); }; |
205 | like($@, qr/Negative signals/, | |
206 | "Prevent negative signals instead of core dumping"); |