This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
OpenBSD does not do si_uid with sigaction().
[perl5.git] / ext / POSIX / t / sigaction.t
CommitLineData
1dfe7606 1#!./perl
2
1dfe7606 3BEGIN{
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
cdfe2e65 14use Test::More tests => 36;
37d19de8 15
1dfe7606 16use strict;
3609ea0d 17use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
1dfe7606 18
19$^W=1;
20
1dfe7606 21sub IGNORE {
a572b909 22 ++$bad7;
1dfe7606 23}
24
25sub DEFAULT {
a572b909 26 ++$bad18;
1dfe7606 27}
28
29sub foo {
a572b909 30 ++$ok;
1dfe7606 31}
32
33my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
34my $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);
a572b909 40 is($bad, undef, "no warnings");
1dfe7606 41}
42
a572b909 43like($oldaction->{HANDLER}, qr/\A(?:DEFAULT|IGNORE)\z/, '$oldaction->{HANDLER}');
3609ea0d
JH
44
45is($SIG{HUP}, '::foo');
1dfe7606 46
47sigaction(SIGHUP, $newaction, $oldaction);
3609ea0d
JH
48is($oldaction->{HANDLER}, '::foo');
49
50ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK");
51
52SKIP: {
53 skip("sigaction() thinks different in $^O", 1)
54 if $^O eq 'linux' || $^O eq 'unicos';
55 is($oldaction->{FLAGS}, 0);
1dfe7606 56}
57
58$newaction=POSIX::SigAction->new('IGNORE');
59sigaction(SIGHUP, $newaction);
60kill 'HUP', $$;
a572b909 61is($bad, undef, "SIGHUP ignored");
1dfe7606 62
3609ea0d 63is($SIG{HUP}, 'IGNORE');
1dfe7606 64sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
3609ea0d 65is($SIG{HUP}, 'DEFAULT');
1dfe7606 66
a572b909 67$newaction=POSIX::SigAction->new(sub { ++$ok10; });
1dfe7606 68sigaction(SIGHUP, $newaction);
69{
70 local($^W)=0;
71 kill 'HUP', $$;
72}
a572b909 73is($ok10, 1, "SIGHUP handler called");
1dfe7606 74
3609ea0d 75is(ref($SIG{HUP}), 'CODE');
1dfe7606 76
77sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
78# Make sure the signal mask gets restored after sigaction croak()s.
79eval {
80 my $act=POSIX::SigAction->new('::foo');
81 delete $act->{HANDLER};
82 sigaction(SIGINT, $act);
83};
84kill 'HUP', $$;
a572b909 85is($ok, 1, "signal mask gets restored after croak");
1dfe7606 86
87undef $ok;
88# Make sure the signal mask gets restored after sigaction returns early.
89my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
90kill 'HUP', $$;
a572b909
NC
91is($x, '', "signal mask gets restored after early return");
92is($ok, 1, "signal mask gets restored after early return");
1dfe7606 93
94$SIG{HUP}=sub {};
95sigaction(SIGHUP, $newaction, $oldaction);
3609ea0d 96is(ref($oldaction->{HANDLER}), 'CODE');
1dfe7606 97
98eval {
99 sigaction(SIGHUP, undef, $oldaction);
100};
a572b909 101is($@, '', "undef for new action");
1dfe7606 102
103eval {
104 sigaction(SIGHUP, 0, $oldaction);
105};
a572b909 106is($@, '', "zero for new action");
1dfe7606 107
108eval {
109 sigaction(SIGHUP, bless({},'Class'), $oldaction);
110};
a572b909
NC
111like($@, qr/\Aaction is not of type POSIX::SigAction/,
112 'any object not good as new action');
1dfe7606 113
3609ea0d
JH
114SKIP: {
115 skip("SIGCONT not trappable in $^O", 1)
116 if ($^O eq 'VMS');
a572b909 117 $newaction=POSIX::SigAction->new(sub { ++$ok10; });
f6a06849
JH
118 if (eval { SIGCONT; 1 }) {
119 sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
120 {
121 local($^W)=0;
122 kill 'CONT', $$;
123 }
4f0c37ba 124 }
a572b909 125 is($bad18, undef, "SIGCONT trappable");
1dfe7606 126}
1dfe7606 127
1d81eac9
JH
128{
129 local $SIG{__WARN__} = sub { }; # Just suffer silently.
130
131 my $hup20;
132 my $hup21;
133
134 sub hup20 { $hup20++ }
135 sub hup21 { $hup21++ }
136
137 sigaction("FOOBAR", $newaction);
a572b909 138 pass("no coredump, still alive");
1d81eac9
JH
139
140 $newaction = POSIX::SigAction->new("hup20");
141 sigaction("SIGHUP", $newaction);
142 kill "HUP", $$;
3609ea0d 143 is($hup20, 1);
1d81eac9
JH
144
145 $newaction = POSIX::SigAction->new("hup21");
146 sigaction("HUP", $newaction);
147 kill "HUP", $$;
3609ea0d 148 is ($hup21, 1);
1d81eac9 149}
d36b6582
CS
150
151# "safe" attribute.
152# for this one, use the accessor instead of the attribute
153
154# standard signal handling via %SIG is safe
155$SIG{HUP} = \&foo;
156$oldaction = POSIX::SigAction->new;
157sigaction(SIGHUP, undef, $oldaction);
3609ea0d 158ok($oldaction->safe, "SIGHUP is safe");
d36b6582
CS
159
160# SigAction handling is not safe ...
161sigaction(SIGHUP, POSIX::SigAction->new(\&foo));
162sigaction(SIGHUP, undef, $oldaction);
3609ea0d 163ok(!$oldaction->safe, "SigAction not safe by default");
d36b6582
CS
164
165# ... unless we say so!
166$newaction = POSIX::SigAction->new(\&foo);
167$newaction->safe(1);
168sigaction(SIGHUP, $newaction);
169sigaction(SIGHUP, undef, $oldaction);
3609ea0d 170ok($oldaction->safe, "SigAction can be safe");
d36b6582
CS
171
172# And safe signal delivery must work
173$ok = 0;
174kill 'HUP', $$;
a572b909 175is($ok, 1, "safe signal delivery must work");
3609ea0d
JH
176
177SKIP: {
8d13d857 178 eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX); scalar %SIGRT + SIGRTMIN() + SIGRTMAX()';
ba822478
MB
179 $@ # POSIX did not exort
180 || SIGRTMIN() < 0 || SIGRTMAX() < 0 # HP-UX 10.20 exports both as -1
181 || SIGRTMIN() > $Config{sig_count} # AIX 4.3.3 exports bogus 888 and 999
182 and skip("no SIGRT signals", 4);
a572b909 183 cmp_ok(SIGRTMAX(), '>', SIGRTMIN(), "SIGRTMAX > SIGRTMIN");
3609ea0d
JH
184 is(scalar %SIGRT, SIGRTMAX() - SIGRTMIN() + 1, "scalar SIGRT");
185 my $sigrtmin;
186 my $h = sub { $sigrtmin = 1 };
187 $SIGRT{SIGRTMIN} = $h;
188 is($SIGRT{SIGRTMIN}, $h, "handler set & get");
189 kill 'SIGRTMIN', $$;
190 is($sigrtmin, 1, "SIGRTMIN handler works");
191}
8aad04aa
JH
192
193SKIP: {
cdfe2e65
DIM
194 my %siginfo = (
195 signo => SIGHUP,
196 pid => $$,
197 uid => $<,
198 );
199 my %opt_val = ( code => 'SI_USER' );
200 my %always = map +($_ => 1), qw(signo code);
201 my %skip = ( code => { darwin => "not set to SI_USER for kill()" } );
997a8cae 202 $skip{pid}{$^O} = $skip{uid}{$^O} = "not set for kill()"
fe13cdfc
JH
203 if (($^O.$Config{osvers}) =~ /^darwin[0-8]\./
204 ||
205 ($^O.$Config{osvers}) =~ /^openbsd[0-5]\./);
cdfe2e65 206 my $tests = keys %{{ %siginfo, %opt_val }};
8aad04aa 207 eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO';
cdfe2e65
DIM
208 skip("no SA_SIGINFO", $tests) if $@;
209 skip("SA_SIGINFO is broken on AIX 4.2", $tests) if ($^O.$Config{osvers}) =~ m/^aix4\.2/;
210 skip("SA_SIGINFO is broken on os390", $tests) if ($^O.$Config{osvers}) =~ m/os390/;
211 eval "use POSIX qw($opt_val{$_}); \$siginfo{$_} = $opt_val{$_}"
212 for keys %opt_val;
8aad04aa 213 sub hiphup {
cdfe2e65
DIM
214 for my $field (sort keys %{{ %siginfo, %opt_val }}) {
215 SKIP: {
216 skip("siginfo_t has no $field field", 1)
217 unless %always{$field} or ($Config{"d_siginfo_si_$field"} || '') eq 'define';
218 skip("no constant defined for SA_SIGINFO $field value $opt_val{$field}", 1)
219 unless defined $siginfo{$field};
220 skip("SA_SIGINFO $field value is wrong on $^O: $skip{$field}{$^O}", 1)
221 if $skip{$field}{$^O};
222 is($_[1]->{$field}, $siginfo{$field}, "SA_SIGINFO got right $field")
223 }
224 }
8aad04aa
JH
225 }
226 my $act = POSIX::SigAction->new('hiphup', 0, SA_SIGINFO);
227 sigaction(SIGHUP, $act);
228 kill 'HUP', $$;
229}
230
516d25e8
SP
231eval { sigaction(-999, "foo"); };
232like($@, qr/Negative signals/,
233 "Prevent negative signals instead of core dumping");
17cffb37
TC
234
235# RT 77432 - assertion failure with POSIX::SigAction
236{
237 local *SIG = {};
238 ok(sigaction(SIGHUP, POSIX::SigAction->new),
239 "sigaction would crash/assert with a replaced %SIG");
240}