5 unshift @INC, '../lib';
9 # Don't do anything if POSIX is missing, or sigaction missing.
12 if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' ||
13 $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) {
19 use Test::More tests => 30;
22 use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
38 my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
39 my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
43 local($SIG{__WARN__})=sub { $bad=1; };
44 sigaction(SIGHUP, $newaction, $oldaction);
45 ok(!$bad, "no warnings");
48 ok($oldaction->{HANDLER} eq 'DEFAULT' ||
49 $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER});
51 is($SIG{HUP}, '::foo');
53 sigaction(SIGHUP, $newaction, $oldaction);
54 is($oldaction->{HANDLER}, '::foo');
56 ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK");
59 skip("sigaction() thinks different in $^O", 1)
60 if $^O eq 'linux' || $^O eq 'unicos';
61 is($oldaction->{FLAGS}, 0);
64 $newaction=POSIX::SigAction->new('IGNORE');
65 sigaction(SIGHUP, $newaction);
67 ok(!$bad, "SIGHUP ignored");
69 is($SIG{HUP}, 'IGNORE');
70 sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
71 is($SIG{HUP}, 'DEFAULT');
73 $newaction=POSIX::SigAction->new(sub { $ok10=1; });
74 sigaction(SIGHUP, $newaction);
79 ok($ok10, "SIGHUP handler called");
81 is(ref($SIG{HUP}), 'CODE');
83 sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
84 # Make sure the signal mask gets restored after sigaction croak()s.
86 my $act=POSIX::SigAction->new('::foo');
87 delete $act->{HANDLER};
88 sigaction(SIGINT, $act);
91 ok($ok, "signal mask gets restored after croak");
94 # Make sure the signal mask gets restored after sigaction returns early.
95 my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
97 ok(!$x && $ok, "signal mask gets restored after early return");
100 sigaction(SIGHUP, $newaction, $oldaction);
101 is(ref($oldaction->{HANDLER}), 'CODE');
104 sigaction(SIGHUP, undef, $oldaction);
106 ok(!$@, "undef for new action");
109 sigaction(SIGHUP, 0, $oldaction);
111 ok(!$@, "zero for new action");
114 sigaction(SIGHUP, bless({},'Class'), $oldaction);
116 ok($@, "any object not good as new action");
119 skip("SIGCONT not trappable in $^O", 1)
121 $newaction=POSIX::SigAction->new(sub { $ok10=1; });
122 if (eval { SIGCONT; 1 }) {
123 sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
129 ok(!$bad18, "SIGCONT trappable");
133 local $SIG{__WARN__} = sub { }; # Just suffer silently.
138 sub hup20 { $hup20++ }
139 sub hup21 { $hup21++ }
141 sigaction("FOOBAR", $newaction);
142 ok(1, "no coredump, still alive");
144 $newaction = POSIX::SigAction->new("hup20");
145 sigaction("SIGHUP", $newaction);
149 $newaction = POSIX::SigAction->new("hup21");
150 sigaction("HUP", $newaction);
156 # for this one, use the accessor instead of the attribute
158 # standard signal handling via %SIG is safe
160 $oldaction = POSIX::SigAction->new;
161 sigaction(SIGHUP, undef, $oldaction);
162 ok($oldaction->safe, "SIGHUP is safe");
164 # SigAction handling is not safe ...
165 sigaction(SIGHUP, POSIX::SigAction->new(\&foo));
166 sigaction(SIGHUP, undef, $oldaction);
167 ok(!$oldaction->safe, "SigAction not safe by default");
169 # ... unless we say so!
170 $newaction = POSIX::SigAction->new(\&foo);
172 sigaction(SIGHUP, $newaction);
173 sigaction(SIGHUP, undef, $oldaction);
174 ok($oldaction->safe, "SigAction can be safe");
176 # And safe signal delivery must work
179 ok($ok, "safe signal delivery must work");
182 eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX); SIGRTMIN + SIGRTMAX';
183 skip("no SIGRT signals", 4) if $@;
184 ok(SIGRTMAX > SIGRTMIN, "SIGRTMAX > SIGRTMIN");
185 is(scalar %SIGRT, SIGRTMAX() - SIGRTMIN() + 1, "scalar SIGRT");
187 my $h = sub { $sigrtmin = 1 };
188 $SIGRT{SIGRTMIN} = $h;
189 is($SIGRT{SIGRTMIN}, $h, "handler set & get");
191 is($sigrtmin, 1, "SIGRTMIN handler works");
195 eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO';
196 skip("no SA_SIGINFO", 1) if $@;
198 is($_[1]->{pid}, $$, "SA_SIGINFO got right pid");
200 my $act = POSIX::SigAction->new('hiphup', 0, SA_SIGINFO);
201 sigaction(SIGHUP, $act);