1#!./perl
2
3BEGIN {
4	chdir 't' if -d 't';
5	unshift @INC, '../lib';
6}
7
8BEGIN{
9	# Don't do anything if POSIX is missing, or sigaction missing.
10	use Config;
11	eval 'use POSIX';
12	if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' ||
13	   $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) {
14		print "1..0\n";
15		exit 0;
16	}
17}
18
19use strict;
20use vars qw/$bad7 $ok10 $bad18 $ok/;
21
22$^W=1;
23
24print "1..25\n";
25
26sub IGNORE {
27	$bad7=1;
28}
29
30sub DEFAULT {
31	$bad18=1;
32}
33
34sub foo {
35	$ok=1;
36}
37
38my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
39my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
40
41{
42	my $bad;
43	local($SIG{__WARN__})=sub { $bad=1; };
44	sigaction(SIGHUP, $newaction, $oldaction);
45	if($bad) { print "not ok 1\n" } else { print "ok 1\n"}
46}
47
48if($oldaction->{HANDLER} eq 'DEFAULT' ||
49   $oldaction->{HANDLER} eq 'IGNORE')
50  { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"}
51print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n";
52
53sigaction(SIGHUP, $newaction, $oldaction);
54if($oldaction->{HANDLER} eq '::foo')
55  { print "ok 4\n" } else { print "not ok 4\n"}
56if($oldaction->{MASK}->ismember(SIGUSR1))
57  { print "ok 5\n" } else { print "not ok 5\n"}
58if($oldaction->{FLAGS}) {
59    if ($^O eq 'linux' || $^O eq 'unicos') {
60	print "ok 6 # Skip: sigaction() thinks different in $^O\n";
61    } else {
62	print "not ok 6\n";
63    }
64} else {
65    print "ok 6\n";
66}
67
68$newaction=POSIX::SigAction->new('IGNORE');
69sigaction(SIGHUP, $newaction);
70kill 'HUP', $$;
71print $bad7 ? "not ok 7\n" : "ok 7\n";
72
73print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n";
74sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
75print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n";
76
77$newaction=POSIX::SigAction->new(sub { $ok10=1; });
78sigaction(SIGHUP, $newaction);
79{
80	local($^W)=0;
81	kill 'HUP', $$;
82}
83print $ok10 ? "ok 10\n" : "not ok 10\n";
84
85print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n";
86
87sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
88# Make sure the signal mask gets restored after sigaction croak()s.
89eval {
90	my $act=POSIX::SigAction->new('::foo');
91	delete $act->{HANDLER};
92	sigaction(SIGINT, $act);
93};
94kill 'HUP', $$;
95print $ok ? "ok 12\n" : "not ok 12\n";
96
97undef $ok;
98# Make sure the signal mask gets restored after sigaction returns early.
99my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
100kill 'HUP', $$;
101print !$x && $ok ? "ok 13\n" : "not ok 13\n";
102
103$SIG{HUP}=sub {};
104sigaction(SIGHUP, $newaction, $oldaction);
105print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n";
106
107eval {
108	sigaction(SIGHUP, undef, $oldaction);
109};
110print $@ ? "not ok 15\n" : "ok 15\n";
111
112eval {
113	sigaction(SIGHUP, 0, $oldaction);
114};
115print $@ ? "not ok 16\n" : "ok 16\n";
116
117eval {
118	sigaction(SIGHUP, bless({},'Class'), $oldaction);
119};
120print $@ ? "ok 17\n" : "not ok 17\n";
121
122if ($^O eq 'VMS') {
123    print "ok 18 # Skip: SIGCONT not trappable in $^O\n";
124} else {
125    $newaction=POSIX::SigAction->new(sub { $ok10=1; });
126    if (eval { SIGCONT; 1 }) {
127	sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
128	{
129	    local($^W)=0;
130	    kill 'CONT', $$;
131	}
132    }
133    print $bad18 ? "not ok 18\n" : "ok 18\n";
134}
135
136{
137    local $SIG{__WARN__} = sub { }; # Just suffer silently.
138
139    my $hup20;
140    my $hup21;
141
142    sub hup20 { $hup20++ }
143    sub hup21 { $hup21++ }
144
145    sigaction("FOOBAR", $newaction);
146    print "ok 19\n"; # no coredump, still alive
147
148    $newaction = POSIX::SigAction->new("hup20");
149    sigaction("SIGHUP", $newaction);
150    kill "HUP", $$;
151    print $hup20 == 1 ? "ok 20\n" : "not ok 20\n";
152
153    $newaction = POSIX::SigAction->new("hup21");
154    sigaction("HUP", $newaction);
155    kill "HUP", $$;
156    print $hup21 == 1 ? "ok 21\n" : "not ok 21\n";
157}
158
159# "safe" attribute.
160# for this one, use the accessor instead of the attribute
161
162# standard signal handling via %SIG is safe
163$SIG{HUP} = \&foo;
164$oldaction = POSIX::SigAction->new;
165sigaction(SIGHUP, undef, $oldaction);
166print $oldaction->safe ? "ok 22\n" : "not ok 22\n";
167
168# SigAction handling is not safe ...
169sigaction(SIGHUP, POSIX::SigAction->new(\&foo));
170sigaction(SIGHUP, undef, $oldaction);
171print $oldaction->safe ? "not ok 23\n" : "ok 23\n";
172
173# ... unless we say so!
174$newaction = POSIX::SigAction->new(\&foo);
175$newaction->safe(1);
176sigaction(SIGHUP, $newaction);
177sigaction(SIGHUP, undef, $oldaction);
178print $oldaction->safe ? "ok 24\n" : "not ok 24\n";
179
180# And safe signal delivery must work
181$ok = 0;
182kill 'HUP', $$;
183print $ok ? "ok 25\n" : "not ok 25\n";
184