This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix the AIX skip to only skip on AIX
[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
17cffb37 14use Test::More tests => 32;
37d19de8 15
1dfe7606 16use strict;
3609ea0d 17use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
1dfe7606 18
19$^W=1;
20
1dfe7606 21sub IGNORE {
22 $bad7=1;
23}
24
25sub DEFAULT {
26 $bad18=1;
27}
28
29sub foo {
30 $ok=1;
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);
3609ea0d 40 ok(!$bad, "no warnings");
1dfe7606 41}
42
3609ea0d
JH
43ok($oldaction->{HANDLER} eq 'DEFAULT' ||
44 $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER});
45
46is($SIG{HUP}, '::foo');
1dfe7606 47
48sigaction(SIGHUP, $newaction, $oldaction);
3609ea0d
JH
49is($oldaction->{HANDLER}, '::foo');
50
51ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK");
52
53SKIP: {
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');
60sigaction(SIGHUP, $newaction);
61kill 'HUP', $$;
3609ea0d 62ok(!$bad, "SIGHUP ignored");
1dfe7606 63
3609ea0d 64is($SIG{HUP}, 'IGNORE');
1dfe7606 65sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
3609ea0d 66is($SIG{HUP}, 'DEFAULT');
1dfe7606 67
68$newaction=POSIX::SigAction->new(sub { $ok10=1; });
69sigaction(SIGHUP, $newaction);
70{
71 local($^W)=0;
72 kill 'HUP', $$;
73}
3609ea0d 74ok($ok10, "SIGHUP handler called");
1dfe7606 75
3609ea0d 76is(ref($SIG{HUP}), 'CODE');
1dfe7606 77
78sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
79# Make sure the signal mask gets restored after sigaction croak()s.
80eval {
81 my $act=POSIX::SigAction->new('::foo');
82 delete $act->{HANDLER};
83 sigaction(SIGINT, $act);
84};
85kill 'HUP', $$;
3609ea0d 86ok($ok, "signal mask gets restored after croak");
1dfe7606 87
88undef $ok;
89# Make sure the signal mask gets restored after sigaction returns early.
90my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
91kill 'HUP', $$;
3609ea0d 92ok(!$x && $ok, "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};
3609ea0d 101ok(!$@, "undef for new action");
1dfe7606 102
103eval {
104 sigaction(SIGHUP, 0, $oldaction);
105};
3609ea0d 106ok(!$@, "zero for new action");
1dfe7606 107
108eval {
109 sigaction(SIGHUP, bless({},'Class'), $oldaction);
110};
3609ea0d 111ok($@, "any object not good as new action");
1dfe7606 112
3609ea0d
JH
113SKIP: {
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;
156sigaction(SIGHUP, undef, $oldaction);
3609ea0d 157ok($oldaction->safe, "SIGHUP is safe");
d36b6582
CS
158
159# SigAction handling is not safe ...
160sigaction(SIGHUP, POSIX::SigAction->new(\&foo));
161sigaction(SIGHUP, undef, $oldaction);
3609ea0d 162ok(!$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);
167sigaction(SIGHUP, $newaction);
168sigaction(SIGHUP, undef, $oldaction);
3609ea0d 169ok($oldaction->safe, "SigAction can be safe");
d36b6582
CS
170
171# And safe signal delivery must work
172$ok = 0;
173kill 'HUP', $$;
3609ea0d
JH
174ok($ok, "safe signal delivery must work");
175
176SKIP: {
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
192SKIP: {
193 eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO';
194 skip("no SA_SIGINFO", 1) if $@;
c89e1b5c 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
204eval { sigaction(-999, "foo"); };
205like($@, qr/Negative signals/,
206 "Prevent negative signals instead of core dumping");
17cffb37
TC
207
208# RT 77432 - assertion failure with POSIX::SigAction
209{
210 local *SIG = {};
211 ok(sigaction(SIGHUP, POSIX::SigAction->new),
212 "sigaction would crash/assert with a replaced %SIG");
213}