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
1 #!./perl
2
3 BEGIN{
4         # Don't do anything if POSIX is missing, or sigaction missing.
5         use Config;
6         eval 'use POSIX';
7         if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' ||
8            $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) {
9                 print "1..0\n";
10                 exit 0;
11         }
12 }
13
14 use Test::More tests => 32;
15
16 use strict;
17 use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
18
19 $^W=1;
20
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);
40         ok(!$bad, "no warnings");
41 }
42
43 ok($oldaction->{HANDLER} eq 'DEFAULT' ||
44    $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER});
45
46 is($SIG{HUP}, '::foo');
47
48 sigaction(SIGHUP, $newaction, $oldaction);
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);
57 }
58
59 $newaction=POSIX::SigAction->new('IGNORE');
60 sigaction(SIGHUP, $newaction);
61 kill 'HUP', $$;
62 ok(!$bad, "SIGHUP ignored");
63
64 is($SIG{HUP}, 'IGNORE');
65 sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
66 is($SIG{HUP}, 'DEFAULT');
67
68 $newaction=POSIX::SigAction->new(sub { $ok10=1; });
69 sigaction(SIGHUP, $newaction);
70 {
71         local($^W)=0;
72         kill 'HUP', $$;
73 }
74 ok($ok10, "SIGHUP handler called");
75
76 is(ref($SIG{HUP}), 'CODE');
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', $$;
86 ok($ok, "signal mask gets restored after croak");
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', $$;
92 ok(!$x && $ok, "signal mask gets restored after early return");
93
94 $SIG{HUP}=sub {};
95 sigaction(SIGHUP, $newaction, $oldaction);
96 is(ref($oldaction->{HANDLER}), 'CODE');
97
98 eval {
99         sigaction(SIGHUP, undef, $oldaction);
100 };
101 ok(!$@, "undef for new action");
102
103 eval {
104         sigaction(SIGHUP, 0, $oldaction);
105 };
106 ok(!$@, "zero for new action");
107
108 eval {
109         sigaction(SIGHUP, bless({},'Class'), $oldaction);
110 };
111 ok($@, "any object not good as new action");
112
113 SKIP: {
114     skip("SIGCONT not trappable in $^O", 1)
115         if ($^O eq 'VMS');
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         }
123     }
124     ok(!$bad18, "SIGCONT trappable");
125 }
126
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);
137     ok(1, "no coredump, still alive");
138
139     $newaction = POSIX::SigAction->new("hup20");
140     sigaction("SIGHUP", $newaction);
141     kill "HUP", $$;
142     is($hup20, 1);
143
144     $newaction = POSIX::SigAction->new("hup21");
145     sigaction("HUP", $newaction);
146     kill "HUP", $$;
147     is ($hup21, 1);
148 }
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);
157 ok($oldaction->safe, "SIGHUP is safe");
158
159 # SigAction handling is not safe ...
160 sigaction(SIGHUP, POSIX::SigAction->new(\&foo));
161 sigaction(SIGHUP, undef, $oldaction);
162 ok(!$oldaction->safe, "SigAction not safe by default");
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);
169 ok($oldaction->safe, "SigAction can be safe");
170
171 # And safe signal delivery must work
172 $ok = 0;
173 kill 'HUP', $$;
174 ok($ok, "safe signal delivery must work");
175
176 SKIP: {
177     eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX); scalar %SIGRT + SIGRTMIN() + SIGRTMAX()';
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);
182     ok(SIGRTMAX() > SIGRTMIN(), "SIGRTMAX > SIGRTMIN");
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 }
191
192 SKIP: {
193     eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO';
194     skip("no SA_SIGINFO", 1) if $@;
195     skip("SA_SIGINFO is broken on AIX 4.2", 1) if ($^O.$Config{osvers}) =~ m/^aix4\.2/;
196     sub hiphup {
197         is($_[1]->{signo}, SIGHUP, "SA_SIGINFO got right signal");
198     }
199     my $act = POSIX::SigAction->new('hiphup', 0, SA_SIGINFO);
200     sigaction(SIGHUP, $act);
201     kill 'HUP', $$;
202 }
203
204 eval { sigaction(-999, "foo"); };
205 like($@, qr/Negative signals/,
206     "Prevent negative signals instead of core dumping");
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 }