4 # Don't do anything if POSIX is missing, or sigaction missing.
7 if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' ||
8 $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) {
14 use Test::More tests => 31;
17 use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
33 my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
34 my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
38 local($SIG{__WARN__})=sub { $bad=1; };
39 sigaction(SIGHUP, $newaction, $oldaction);
40 ok(!$bad, "no warnings");
43 ok($oldaction->{HANDLER} eq 'DEFAULT' ||
44 $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER});
46 is($SIG{HUP}, '::foo');
48 sigaction(SIGHUP, $newaction, $oldaction);
49 is($oldaction->{HANDLER}, '::foo');
51 ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK");
54 skip("sigaction() thinks different in $^O", 1)
55 if $^O eq 'linux' || $^O eq 'unicos';
56 is($oldaction->{FLAGS}, 0);
59 $newaction=POSIX::SigAction->new('IGNORE');
60 sigaction(SIGHUP, $newaction);
62 ok(!$bad, "SIGHUP ignored");
64 is($SIG{HUP}, 'IGNORE');
65 sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
66 is($SIG{HUP}, 'DEFAULT');
68 $newaction=POSIX::SigAction->new(sub { $ok10=1; });
69 sigaction(SIGHUP, $newaction);
74 ok($ok10, "SIGHUP handler called");
76 is(ref($SIG{HUP}), 'CODE');
78 sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
79 # Make sure the signal mask gets restored after sigaction croak()s.
81 my $act=POSIX::SigAction->new('::foo');
82 delete $act->{HANDLER};
83 sigaction(SIGINT, $act);
86 ok($ok, "signal mask gets restored after croak");
89 # Make sure the signal mask gets restored after sigaction returns early.
90 my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
92 ok(!$x && $ok, "signal mask gets restored after early return");
95 sigaction(SIGHUP, $newaction, $oldaction);
96 is(ref($oldaction->{HANDLER}), 'CODE');
99 sigaction(SIGHUP, undef, $oldaction);
101 ok(!$@, "undef for new action");
104 sigaction(SIGHUP, 0, $oldaction);
106 ok(!$@, "zero for new action");
109 sigaction(SIGHUP, bless({},'Class'), $oldaction);
111 ok($@, "any object not good as new action");
114 skip("SIGCONT not trappable in $^O", 1)
116 $newaction=POSIX::SigAction->new(sub { $ok10=1; });
117 if (eval { SIGCONT; 1 }) {
118 sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
124 ok(!$bad18, "SIGCONT trappable");
128 local $SIG{__WARN__} = sub { }; # Just suffer silently.
133 sub hup20 { $hup20++ }
134 sub hup21 { $hup21++ }
136 sigaction("FOOBAR", $newaction);
137 ok(1, "no coredump, still alive");
139 $newaction = POSIX::SigAction->new("hup20");
140 sigaction("SIGHUP", $newaction);
144 $newaction = POSIX::SigAction->new("hup21");
145 sigaction("HUP", $newaction);
151 # for this one, use the accessor instead of the attribute
153 # standard signal handling via %SIG is safe
155 $oldaction = POSIX::SigAction->new;
156 sigaction(SIGHUP, undef, $oldaction);
157 ok($oldaction->safe, "SIGHUP is safe");
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");
164 # ... unless we say so!
165 $newaction = POSIX::SigAction->new(\&foo);
167 sigaction(SIGHUP, $newaction);
168 sigaction(SIGHUP, undef, $oldaction);
169 ok($oldaction->safe, "SigAction can be safe");
171 # And safe signal delivery must work
174 ok($ok, "safe signal delivery must work");
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");
185 my $h = sub { $sigrtmin = 1 };
186 $SIGRT{SIGRTMIN} = $h;
187 is($SIGRT{SIGRTMIN}, $h, "handler set & get");
189 is($sigrtmin, 1, "SIGRTMIN handler works");
193 eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO';
194 skip("no SA_SIGINFO", 1) if $@;
196 is($_[1]->{signo}, SIGHUP, "SA_SIGINFO got right signal");
198 my $act = POSIX::SigAction->new('hiphup', 0, SA_SIGINFO);
199 sigaction(SIGHUP, $act);
203 eval { sigaction(-999, "foo"); };
204 like($@, qr/Negative signals/,
205 "Prevent negative signals instead of core dumping");