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
1 #!./perl
2
3 use Test::More tests => 29;
4
5 BEGIN {
6         chdir 't' if -d 't';
7         unshift @INC, '../lib';
8 }
9
10 BEGIN{
11         # Don't do anything if POSIX is missing, or sigaction missing.
12         use Config;
13         eval 'use POSIX';
14         if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' ||
15            $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) {
16                 print "1..0\n";
17                 exit 0;
18         }
19 }
20
21 use strict;
22 use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
23
24 $^W=1;
25
26 sub IGNORE {
27         $bad7=1;
28 }
29
30 sub DEFAULT {
31         $bad18=1;
32 }
33
34 sub foo {
35         $ok=1;
36 }
37
38 my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
39 my $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         ok(!$bad, "no warnings");
46 }
47
48 ok($oldaction->{HANDLER} eq 'DEFAULT' ||
49    $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER});
50
51 is($SIG{HUP}, '::foo');
52
53 sigaction(SIGHUP, $newaction, $oldaction);
54 is($oldaction->{HANDLER}, '::foo');
55
56 ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK");
57
58 SKIP: {
59     skip("sigaction() thinks different in $^O", 1)
60         if $^O eq 'linux' || $^O eq 'unicos';
61     is($oldaction->{FLAGS}, 0);
62 }
63
64 $newaction=POSIX::SigAction->new('IGNORE');
65 sigaction(SIGHUP, $newaction);
66 kill 'HUP', $$;
67 ok(!$bad, "SIGHUP ignored");
68
69 is($SIG{HUP}, 'IGNORE');
70 sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
71 is($SIG{HUP}, 'DEFAULT');
72
73 $newaction=POSIX::SigAction->new(sub { $ok10=1; });
74 sigaction(SIGHUP, $newaction);
75 {
76         local($^W)=0;
77         kill 'HUP', $$;
78 }
79 ok($ok10, "SIGHUP handler called");
80
81 is(ref($SIG{HUP}), 'CODE');
82
83 sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
84 # Make sure the signal mask gets restored after sigaction croak()s.
85 eval {
86         my $act=POSIX::SigAction->new('::foo');
87         delete $act->{HANDLER};
88         sigaction(SIGINT, $act);
89 };
90 kill 'HUP', $$;
91 ok($ok, "signal mask gets restored after croak");
92
93 undef $ok;
94 # Make sure the signal mask gets restored after sigaction returns early.
95 my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
96 kill 'HUP', $$;
97 ok(!$x && $ok, "signal mask gets restored after early return");
98
99 $SIG{HUP}=sub {};
100 sigaction(SIGHUP, $newaction, $oldaction);
101 is(ref($oldaction->{HANDLER}), 'CODE');
102
103 eval {
104         sigaction(SIGHUP, undef, $oldaction);
105 };
106 ok(!$@, "undef for new action");
107
108 eval {
109         sigaction(SIGHUP, 0, $oldaction);
110 };
111 ok(!$@, "zero for new action");
112
113 eval {
114         sigaction(SIGHUP, bless({},'Class'), $oldaction);
115 };
116 ok($@, "any object not good as new action");
117
118 SKIP: {
119     skip("SIGCONT not trappable in $^O", 1)
120         if ($^O eq 'VMS');
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         }
128     }
129     ok(!$bad18, "SIGCONT trappable");
130 }
131
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);
142     ok(1, "no coredump, still alive");
143
144     $newaction = POSIX::SigAction->new("hup20");
145     sigaction("SIGHUP", $newaction);
146     kill "HUP", $$;
147     is($hup20, 1);
148
149     $newaction = POSIX::SigAction->new("hup21");
150     sigaction("HUP", $newaction);
151     kill "HUP", $$;
152     is ($hup21, 1);
153 }
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;
161 sigaction(SIGHUP, undef, $oldaction);
162 ok($oldaction->safe, "SIGHUP is safe");
163
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");
168
169 # ... unless we say so!
170 $newaction = POSIX::SigAction->new(\&foo);
171 $newaction->safe(1);
172 sigaction(SIGHUP, $newaction);
173 sigaction(SIGHUP, undef, $oldaction);
174 ok($oldaction->safe, "SigAction can be safe");
175
176 # And safe signal delivery must work
177 $ok = 0;
178 kill 'HUP', $$;
179 ok($ok, "safe signal delivery must work");
180
181 SKIP: {
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");
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 }