xref: /openbsd/gnu/usr.bin/perl/ext/POSIX/t/sigaction.t (revision eac174f2) 
1#!./perl
2
3BEGIN{
4	# Don't do anything if POSIX is missing, or sigaction missing.
5	use Config;
6	eval 'use POSIX';
7	if($@ || $^O eq 'MSWin32' ||
8	   ($^O eq 'VMS' && !$Config{'d_sigaction'})) {
9		print "1..0\n";
10		exit 0;
11	}
12}
13
14use Test::More tests => 36;
15
16use strict;
17our ( $bad, $bad7, $ok10, $bad18, $ok );
18
19$^W=1;
20
21sub IGNORE {
22    ++$bad7;
23}
24
25sub DEFAULT {
26    ++$bad18;
27}
28
29sub foo {
30    ++$ok;
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);
40	is($bad, undef, "no warnings");
41}
42
43like($oldaction->{HANDLER}, qr/\A(?:DEFAULT|IGNORE)\z/, '$oldaction->{HANDLER}');
44
45is($SIG{HUP}, '::foo');
46
47sigaction(SIGHUP, $newaction, $oldaction);
48is($oldaction->{HANDLER}, '::foo');
49
50ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK");
51
52SKIP: {
53    skip("sigaction() thinks different in $^O", 1)
54	if $^O eq 'linux' || $^O eq 'unicos';
55    is($oldaction->{FLAGS}, 0);
56}
57
58$newaction=POSIX::SigAction->new('IGNORE');
59sigaction(SIGHUP, $newaction);
60kill 'HUP', $$;
61is($bad, undef, "SIGHUP ignored");
62
63is($SIG{HUP}, 'IGNORE');
64sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
65is($SIG{HUP}, 'DEFAULT');
66
67$newaction=POSIX::SigAction->new(sub { ++$ok10; });
68sigaction(SIGHUP, $newaction);
69{
70	local($^W)=0;
71	kill 'HUP', $$;
72}
73is($ok10, 1, "SIGHUP handler called");
74
75is(ref($SIG{HUP}), 'CODE');
76
77sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
78# Make sure the signal mask gets restored after sigaction croak()s.
79eval {
80	my $act=POSIX::SigAction->new('::foo');
81	delete $act->{HANDLER};
82	sigaction(SIGINT, $act);
83};
84kill 'HUP', $$;
85is($ok, 1, "signal mask gets restored after croak");
86
87undef $ok;
88# Make sure the signal mask gets restored after sigaction returns early.
89my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
90kill 'HUP', $$;
91is($x, '', "signal mask gets restored after early return");
92is($ok, 1, "signal mask gets restored after early return");
93
94$SIG{HUP}=sub {};
95sigaction(SIGHUP, $newaction, $oldaction);
96is(ref($oldaction->{HANDLER}), 'CODE');
97
98eval {
99	sigaction(SIGHUP, undef, $oldaction);
100};
101is($@, '', "undef for new action");
102
103eval {
104	sigaction(SIGHUP, 0, $oldaction);
105};
106is($@, '', "zero for new action");
107
108eval {
109	sigaction(SIGHUP, bless({},'Class'), $oldaction);
110};
111like($@, qr/\Aaction is not of type POSIX::SigAction/,
112     'any object not good as new action');
113
114SKIP: {
115    skip("SIGCONT not trappable in $^O", 1)
116	if ($^O eq 'VMS');
117    $newaction=POSIX::SigAction->new(sub { ++$ok10; });
118    if (eval { SIGCONT; 1 }) {
119	sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
120	{
121	    local($^W)=0;
122	    kill 'CONT', $$;
123	}
124    }
125    is($bad18, undef, "SIGCONT trappable");
126}
127
128{
129    local $SIG{__WARN__} = sub { }; # Just suffer silently.
130
131    my $hup20;
132    my $hup21;
133
134    sub hup20 { $hup20++ }
135    sub hup21 { $hup21++ }
136
137    sigaction("FOOBAR", $newaction);
138    pass("no coredump, still alive");
139
140    $newaction = POSIX::SigAction->new("hup20");
141    sigaction("SIGHUP", $newaction);
142    kill "HUP", $$;
143    is($hup20, 1);
144
145    $newaction = POSIX::SigAction->new("hup21");
146    sigaction("HUP", $newaction);
147    kill "HUP", $$;
148    is ($hup21, 1);
149}
150
151# "safe" attribute.
152# for this one, use the accessor instead of the attribute
153
154# standard signal handling via %SIG is safe
155$SIG{HUP} = \&foo;
156$oldaction = POSIX::SigAction->new;
157sigaction(SIGHUP, undef, $oldaction);
158ok($oldaction->safe, "SIGHUP is safe");
159
160# SigAction handling is not safe ...
161sigaction(SIGHUP, POSIX::SigAction->new(\&foo));
162sigaction(SIGHUP, undef, $oldaction);
163ok(!$oldaction->safe, "SigAction not safe by default");
164
165# ... unless we say so!
166$newaction = POSIX::SigAction->new(\&foo);
167$newaction->safe(1);
168sigaction(SIGHUP, $newaction);
169sigaction(SIGHUP, undef, $oldaction);
170ok($oldaction->safe, "SigAction can be safe");
171
172# And safe signal delivery must work
173$ok = 0;
174kill 'HUP', $$;
175is($ok, 1, "safe signal delivery must work");
176
177SKIP: {
178    eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX); scalar %SIGRT + SIGRTMIN() + SIGRTMAX()';
179    $@					# POSIX did not exort
180    || SIGRTMIN() < 0 || SIGRTMAX() < 0	# HP-UX 10.20 exports both as -1
181    || SIGRTMIN() > $Config{sig_count}	# AIX 4.3.3 exports bogus 888 and 999
182	and skip("no SIGRT signals", 4);
183    cmp_ok(SIGRTMAX(), '>', SIGRTMIN(), "SIGRTMAX > SIGRTMIN");
184    is(scalar %SIGRT, SIGRTMAX() - SIGRTMIN() + 1, "scalar SIGRT");
185    my $sigrtmin;
186    my $h = sub { $sigrtmin = 1 };
187    $SIGRT{SIGRTMIN} = $h;
188    is($SIGRT{SIGRTMIN}, $h, "handler set & get");
189    kill 'SIGRTMIN', $$;
190    is($sigrtmin, 1, "SIGRTMIN handler works");
191}
192
193SKIP: {
194    my %siginfo = (
195        signo => SIGHUP,
196        pid => $$,
197        uid => $<,
198    );
199    my %opt_val = ( code => 'SI_USER' );
200    my %always = map +($_ => 1), qw(signo code);
201    my %skip = ( code => { darwin => "not set to SI_USER for kill()" } );
202    $skip{pid}{$^O} = $skip{uid}{$^O} = "not set for kill()"
203        if (($^O.$Config{osvers}) =~ /^darwin[0-8]\./
204            ||
205            ($^O.$Config{osvers}) =~ /^openbsd[0-7]\./
206            ||
207            ($^O eq 'gnu')
208            ||
209            ($^O eq 'dragonfly'));
210    my $tests = keys %{{ %siginfo, %opt_val }};
211    eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO';
212    skip("no SA_SIGINFO", $tests) if $@;
213    skip("SA_SIGINFO is broken on AIX 4.2", $tests) if ($^O.$Config{osvers}) =~ m/^aix4\.2/;
214    skip("SA_SIGINFO is broken on os390", $tests) if ($^O.$Config{osvers}) =~ m/os390/;
215    eval "use POSIX qw($opt_val{$_}); \$siginfo{$_} = $opt_val{$_}"
216        for keys %opt_val;
217    sub hiphup {
218        for my $field (sort keys %{{ %siginfo, %opt_val }}) {
219            SKIP: {
220                skip("siginfo_t has no $field field", 1)
221                    unless %always{$field} or ($Config{"d_siginfo_si_$field"} || '') eq 'define';
222                skip("no constant defined for SA_SIGINFO $field value $opt_val{$field}", 1)
223                    unless defined $siginfo{$field};
224                skip("SA_SIGINFO $field value is wrong on $^O: $skip{$field}{$^O}", 1)
225                    if $skip{$field}{$^O};
226                is($_[1]->{$field}, $siginfo{$field}, "SA_SIGINFO got right $field")
227            }
228        }
229    }
230    my $act = POSIX::SigAction->new('hiphup', 0, SA_SIGINFO);
231    sigaction(SIGHUP, $act);
232    kill 'HUP', $$;
233}
234
235eval { sigaction(-999, "foo"); };
236like($@, qr/Negative signals/,
237    "Prevent negative signals instead of core dumping");
238
239# RT 77432 - assertion failure with POSIX::SigAction
240{
241  local *SIG = {};
242  ok(sigaction(SIGHUP, POSIX::SigAction->new),
243     "sigaction would crash/assert with a replaced %SIG");
244}
245