This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
XS constants fail when their value is called for, not at import.
[perl5.git] / ext / POSIX / t / sigaction.t
CommitLineData
1dfe7606
AJ
1#!./perl
2
3609ea0d
JH
3use Test::More tests => 29;
4
1dfe7606
AJ
5BEGIN {
6 chdir 't' if -d 't';
7 unshift @INC, '../lib';
8}
9
10BEGIN{
11 # Don't do anything if POSIX is missing, or sigaction missing.
fdfddb36 12 use Config;
84251760 13 eval 'use POSIX';
4176a672 14 if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' ||
e69a2255 15 $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) {
1dfe7606
AJ
16 print "1..0\n";
17 exit 0;
18 }
19}
20
21use strict;
3609ea0d 22use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
1dfe7606
AJ
23
24$^W=1;
25
1dfe7606
AJ
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);
3609ea0d 45 ok(!$bad, "no warnings");
1dfe7606
AJ
46}
47
3609ea0d
JH
48ok($oldaction->{HANDLER} eq 'DEFAULT' ||
49 $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER});
50
51is($SIG{HUP}, '::foo');
1dfe7606
AJ
52
53sigaction(SIGHUP, $newaction, $oldaction);
3609ea0d
JH
54is($oldaction->{HANDLER}, '::foo');
55
56ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK");
57
58SKIP: {
59 skip("sigaction() thinks different in $^O", 1)
60 if $^O eq 'linux' || $^O eq 'unicos';
61 is($oldaction->{FLAGS}, 0);
1dfe7606
AJ
62}
63
64$newaction=POSIX::SigAction->new('IGNORE');
65sigaction(SIGHUP, $newaction);
66kill 'HUP', $$;
3609ea0d 67ok(!$bad, "SIGHUP ignored");
1dfe7606 68
3609ea0d 69is($SIG{HUP}, 'IGNORE');
1dfe7606 70sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
3609ea0d 71is($SIG{HUP}, 'DEFAULT');
1dfe7606
AJ
72
73$newaction=POSIX::SigAction->new(sub { $ok10=1; });
74sigaction(SIGHUP, $newaction);
75{
76 local($^W)=0;
77 kill 'HUP', $$;
78}
3609ea0d 79ok($ok10, "SIGHUP handler called");
1dfe7606 80
3609ea0d 81is(ref($SIG{HUP}), 'CODE');
1dfe7606
AJ
82
83sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
84# Make sure the signal mask gets restored after sigaction croak()s.
85eval {
86 my $act=POSIX::SigAction->new('::foo');
87 delete $act->{HANDLER};
88 sigaction(SIGINT, $act);
89};
90kill 'HUP', $$;
3609ea0d 91ok($ok, "signal mask gets restored after croak");
1dfe7606
AJ
92
93undef $ok;
94# Make sure the signal mask gets restored after sigaction returns early.
95my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
96kill 'HUP', $$;
3609ea0d 97ok(!$x && $ok, "signal mask gets restored after early return");
1dfe7606
AJ
98
99$SIG{HUP}=sub {};
100sigaction(SIGHUP, $newaction, $oldaction);
3609ea0d 101is(ref($oldaction->{HANDLER}), 'CODE');
1dfe7606
AJ
102
103eval {
104 sigaction(SIGHUP, undef, $oldaction);
105};
3609ea0d 106ok(!$@, "undef for new action");
1dfe7606
AJ
107
108eval {
109 sigaction(SIGHUP, 0, $oldaction);
110};
3609ea0d 111ok(!$@, "zero for new action");
1dfe7606
AJ
112
113eval {
114 sigaction(SIGHUP, bless({},'Class'), $oldaction);
115};
3609ea0d 116ok($@, "any object not good as new action");
1dfe7606 117
3609ea0d
JH
118SKIP: {
119 skip("SIGCONT not trappable in $^O", 1)
120 if ($^O eq 'VMS');
f6a06849
JH
121 $newaction=POSIX::SigAction->new(sub { $ok10=1; });
122 if (eval { SIGCONT; 1 }) {
123 sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
124 {
125 local($^W)=0;
126 kill 'CONT', $$;
127 }
4f0c37ba 128 }
3609ea0d 129 ok(!$bad18, "SIGCONT trappable");
1dfe7606 130}
1dfe7606 131
1d81eac9
JH
132{
133 local $SIG{__WARN__} = sub { }; # Just suffer silently.
134
135 my $hup20;
136 my $hup21;
137
138 sub hup20 { $hup20++ }
139 sub hup21 { $hup21++ }
140
141 sigaction("FOOBAR", $newaction);
3609ea0d 142 ok(1, "no coredump, still alive");
1d81eac9
JH
143
144 $newaction = POSIX::SigAction->new("hup20");
145 sigaction("SIGHUP", $newaction);
146 kill "HUP", $$;
3609ea0d 147 is($hup20, 1);
1d81eac9
JH
148
149 $newaction = POSIX::SigAction->new("hup21");
150 sigaction("HUP", $newaction);
151 kill "HUP", $$;
3609ea0d 152 is ($hup21, 1);
1d81eac9 153}
d36b6582
CS
154
155# "safe" attribute.
156# for this one, use the accessor instead of the attribute
157
158# standard signal handling via %SIG is safe
159$SIG{HUP} = \&foo;
160$oldaction = POSIX::SigAction->new;
161sigaction(SIGHUP, undef, $oldaction);
3609ea0d 162ok($oldaction->safe, "SIGHUP is safe");
d36b6582
CS
163
164# SigAction handling is not safe ...
165sigaction(SIGHUP, POSIX::SigAction->new(\&foo));
166sigaction(SIGHUP, undef, $oldaction);
3609ea0d 167ok(!$oldaction->safe, "SigAction not safe by default");
d36b6582
CS
168
169# ... unless we say so!
170$newaction = POSIX::SigAction->new(\&foo);
171$newaction->safe(1);
172sigaction(SIGHUP, $newaction);
173sigaction(SIGHUP, undef, $oldaction);
3609ea0d 174ok($oldaction->safe, "SigAction can be safe");
d36b6582
CS
175
176# And safe signal delivery must work
177$ok = 0;
178kill 'HUP', $$;
3609ea0d
JH
179ok($ok, "safe signal delivery must work");
180
181SKIP: {
eb101f41 182 eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX); SIGRTMIN + SIGRTMAX';
3609ea0d
JH
183 skip("no SIGRT signals", 4) if $@;
184 ok(SIGRTMAX > SIGRTMIN, "SIGRTMAX > SIGRTMIN");
185 is(scalar %SIGRT, SIGRTMAX() - SIGRTMIN() + 1, "scalar SIGRT");
186 my $sigrtmin;
187 my $h = sub { $sigrtmin = 1 };
188 $SIGRT{SIGRTMIN} = $h;
189 is($SIGRT{SIGRTMIN}, $h, "handler set & get");
190 kill 'SIGRTMIN', $$;
191 is($sigrtmin, 1, "SIGRTMIN handler works");
192}