Commit | Line | Data |
1dfe7606 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | unshift @INC, '../lib'; |
6 | } |
7 | |
8 | BEGIN{ |
9 | # Don't do anything if POSIX is missing, or sigaction missing. |
fdfddb36 |
10 | use Config; |
84251760 |
11 | eval 'use POSIX'; |
4176a672 |
12 | if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || |
e69a2255 |
13 | $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) { |
1dfe7606 |
14 | print "1..0\n"; |
15 | exit 0; |
16 | } |
17 | } |
18 | |
19 | use strict; |
20 | use vars qw/$bad7 $ok10 $bad18 $ok/; |
21 | |
22 | $^W=1; |
23 | |
d36b6582 |
24 | print "1..25\n"; |
1dfe7606 |
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 | if($bad) { print "not ok 1\n" } else { print "ok 1\n"} |
46 | } |
47 | |
63478870 |
48 | if($oldaction->{HANDLER} eq 'DEFAULT' || |
3253b43b |
49 | $oldaction->{HANDLER} eq 'IGNORE') |
63478870 |
50 | { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"} |
1dfe7606 |
51 | print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n"; |
52 | |
53 | sigaction(SIGHUP, $newaction, $oldaction); |
54 | if($oldaction->{HANDLER} eq '::foo') |
55 | { print "ok 4\n" } else { print "not ok 4\n"} |
56 | if($oldaction->{MASK}->ismember(SIGUSR1)) |
57 | { print "ok 5\n" } else { print "not ok 5\n"} |
58 | if($oldaction->{FLAGS}) { |
b13b12d1 |
59 | if ($^O eq 'linux' || $^O eq 'unicos') { |
60 | print "ok 6 # Skip: sigaction() thinks different in $^O\n"; |
1dfe7606 |
61 | } else { |
62 | print "not ok 6\n"; |
63 | } |
64 | } else { |
65 | print "ok 6\n"; |
66 | } |
67 | |
68 | $newaction=POSIX::SigAction->new('IGNORE'); |
69 | sigaction(SIGHUP, $newaction); |
70 | kill 'HUP', $$; |
71 | print $bad7 ? "not ok 7\n" : "ok 7\n"; |
72 | |
73 | print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n"; |
74 | sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT')); |
75 | print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n"; |
76 | |
77 | $newaction=POSIX::SigAction->new(sub { $ok10=1; }); |
78 | sigaction(SIGHUP, $newaction); |
79 | { |
80 | local($^W)=0; |
81 | kill 'HUP', $$; |
82 | } |
83 | print $ok10 ? "ok 10\n" : "not ok 10\n"; |
84 | |
85 | print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n"; |
86 | |
87 | sigaction(SIGHUP, POSIX::SigAction->new('::foo')); |
88 | # Make sure the signal mask gets restored after sigaction croak()s. |
89 | eval { |
90 | my $act=POSIX::SigAction->new('::foo'); |
91 | delete $act->{HANDLER}; |
92 | sigaction(SIGINT, $act); |
93 | }; |
94 | kill 'HUP', $$; |
95 | print $ok ? "ok 12\n" : "not ok 12\n"; |
96 | |
97 | undef $ok; |
98 | # Make sure the signal mask gets restored after sigaction returns early. |
99 | my $x=defined sigaction(SIGKILL, $newaction, $oldaction); |
100 | kill 'HUP', $$; |
101 | print !$x && $ok ? "ok 13\n" : "not ok 13\n"; |
102 | |
103 | $SIG{HUP}=sub {}; |
104 | sigaction(SIGHUP, $newaction, $oldaction); |
105 | print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n"; |
106 | |
107 | eval { |
108 | sigaction(SIGHUP, undef, $oldaction); |
109 | }; |
110 | print $@ ? "not ok 15\n" : "ok 15\n"; |
111 | |
112 | eval { |
113 | sigaction(SIGHUP, 0, $oldaction); |
114 | }; |
115 | print $@ ? "not ok 16\n" : "ok 16\n"; |
116 | |
117 | eval { |
118 | sigaction(SIGHUP, bless({},'Class'), $oldaction); |
119 | }; |
120 | print $@ ? "ok 17\n" : "not ok 17\n"; |
121 | |
cd0683b0 |
122 | if ($^O eq 'VMS') { |
f6a06849 |
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 | } |
4f0c37ba |
132 | } |
f6a06849 |
133 | print $bad18 ? "not ok 18\n" : "ok 18\n"; |
1dfe7606 |
134 | } |
1dfe7606 |
135 | |
1d81eac9 |
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 | } |
d36b6582 |
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; |
165 | sigaction(SIGHUP, undef, $oldaction); |
166 | print $oldaction->safe ? "ok 22\n" : "not ok 22\n"; |
167 | |
168 | # SigAction handling is not safe ... |
169 | sigaction(SIGHUP, POSIX::SigAction->new(\&foo)); |
170 | sigaction(SIGHUP, undef, $oldaction); |
171 | print $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); |
176 | sigaction(SIGHUP, $newaction); |
177 | sigaction(SIGHUP, undef, $oldaction); |
178 | print $oldaction->safe ? "ok 24\n" : "not ok 24\n"; |
179 | |
180 | # And safe signal delivery must work |
181 | $ok = 0; |
182 | kill 'HUP', $$; |
183 | print $ok ? "ok 25\n" : "not ok 25\n"; |