Commit | Line | Data |
---|---|---|
8f3964af NC |
1 | #!perl -w |
2 | ||
3 | # We assume that TestInit has been used. | |
4 | ||
5 | BEGIN { | |
b5efbd1f | 6 | chdir 't' if -d 't'; |
8f3964af NC |
7 | require './test.pl'; |
8 | } | |
9 | ||
10 | use strict; | |
0c1bf4c7 | 11 | use Config; |
8f3964af | 12 | |
100c03aa | 13 | plan tests => 29; |
6281d426 | 14 | $| = 1; |
8f3964af | 15 | |
a75b628d | 16 | watchdog(25); |
8f3964af NC |
17 | |
18 | $SIG{ALRM} = sub { | |
19 | die "Alarm!\n"; | |
20 | }; | |
21 | ||
22 | pass('before the first loop'); | |
23 | ||
24 | alarm 2; | |
25 | ||
26 | eval { | |
27 | 1 while 1; | |
28 | }; | |
29 | ||
30 | is($@, "Alarm!\n", 'after the first loop'); | |
31 | ||
32 | pass('before the second loop'); | |
33 | ||
34 | alarm 2; | |
35 | ||
36 | eval { | |
37 | while (1) { | |
38 | } | |
39 | }; | |
40 | ||
41 | is($@, "Alarm!\n", 'after the second loop'); | |
0c1bf4c7 LT |
42 | |
43 | SKIP: { | |
61fb63a6 | 44 | skip('We can\'t test blocking without sigprocmask', 17) |
b93d0e62 | 45 | if is_miniperl() || !$Config{d_sigprocmask}; |
054559e9 | 46 | skip("This doesn\'t work on $^O threaded builds RT#88814", 17) |
9f7ba77d JH |
47 | if ($^O =~ /cygwin/ && $Config{useithreads}); |
48 | skip("This doesn\'t work on $^O version $Config{osvers} RT#88814", 17) | |
49 | if ($^O eq "openbsd" && $Config{osvers} < 5.2); | |
0c1bf4c7 LT |
50 | |
51 | require POSIX; | |
61fb63a6 NC |
52 | my $pending = POSIX::SigSet->new(); |
53 | is POSIX::sigpending($pending), '0 but true', 'sigpending'; | |
54 | is $pending->ismember(&POSIX::SIGUSR1), 0, 'SIGUSR1 is not pending'; | |
0c1bf4c7 LT |
55 | my $new = POSIX::SigSet->new(&POSIX::SIGUSR1); |
56 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, $new); | |
57 | ||
58 | my $gotit = 0; | |
59 | $SIG{USR1} = sub { $gotit++ }; | |
eb796c7f | 60 | kill 'SIGUSR1', $$; |
7fe50b8b | 61 | is $gotit, 0, 'Haven\'t received third signal yet'; |
0ac0889d RU |
62 | |
63 | diag "2nd sigpending crashes on cygwin" if $^O eq 'cygwin'; | |
61fb63a6 NC |
64 | is POSIX::sigpending($pending), '0 but true', 'sigpending'; |
65 | is $pending->ismember(&POSIX::SIGUSR1), 1, 'SIGUSR1 is pending'; | |
0c1bf4c7 LT |
66 | |
67 | my $old = POSIX::SigSet->new(); | |
68 | POSIX::sigsuspend($old); | |
69 | is $gotit, 1, 'Received third signal'; | |
61fb63a6 NC |
70 | is POSIX::sigpending($pending), '0 but true', 'sigpending'; |
71 | is $pending->ismember(&POSIX::SIGUSR1), 0, 'SIGUSR1 is no longer pending'; | |
0c1bf4c7 | 72 | |
7fe50b8b | 73 | { |
eb796c7f | 74 | kill 'SIGUSR1', $$; |
7fe50b8b LT |
75 | local $SIG{USR1} = sub { die "FAIL\n" }; |
76 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old); | |
77 | ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is blocked'; | |
78 | eval { POSIX::sigsuspend(POSIX::SigSet->new) }; | |
79 | is $@, "FAIL\n", 'Exception is thrown, so received fourth signal'; | |
80 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old); | |
23292af3 CB |
81 | TODO: |
82 | { | |
83 | local $::TODO = "Needs investigation" if $^O eq 'VMS'; | |
7fe50b8b | 84 | ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is still blocked'; |
23292af3 | 85 | } |
7fe50b8b LT |
86 | } |
87 | ||
554bc0f4 | 88 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, $new); |
eb796c7f | 89 | kill 'SIGUSR1', $$; |
554bc0f4 LT |
90 | is $gotit, 1, 'Haven\'t received fifth signal yet'; |
91 | POSIX::sigprocmask(&POSIX::SIG_UNBLOCK, $new, $old); | |
92 | ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 was still blocked'; | |
7fe50b8b | 93 | is $gotit, 2, 'Received fifth signal'; |
c22d665b LT |
94 | |
95 | # test unsafe signal handlers in combination with exceptions | |
8aed2c65 DM |
96 | |
97 | SKIP: { | |
98 | # #89718: on old linux kernels, this test hangs. No-ones thought | |
99 | # of a reliable way to probe for this, so for now, just skip the | |
100 | # tests on production releases | |
101 | skip("some OSes hang here", 3) if (int($]*1000) & 1) == 0; | |
5322aba4 | 102 | |
4f7dee4f BF |
103 | SKIP: { |
104 | skip("Issues on Android", 3) if $^O =~ /android/; | |
8aed2c65 DM |
105 | my $action = POSIX::SigAction->new(sub { $gotit--, die }, POSIX::SigSet->new, 0); |
106 | POSIX::sigaction(&POSIX::SIGALRM, $action); | |
107 | eval { | |
108 | alarm 1; | |
109 | my $set = POSIX::SigSet->new; | |
110 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $set); | |
111 | is $set->ismember(&POSIX::SIGALRM), 0, "SIGALRM is not blocked on attempt $_"; | |
112 | POSIX::sigsuspend($set); | |
113 | } for 1..2; | |
114 | is $gotit, 0, 'Received both signals'; | |
115 | } | |
0c1bf4c7 | 116 | } |
5322aba4 | 117 | } |
011c3814 | 118 | |
476c37e2 NC |
119 | SKIP: { |
120 | skip("alarm cannot interrupt blocking system calls on $^O", 2) | |
0ac0889d | 121 | if $^O =~ /MSWin32|cygwin|VMS/; |
011c3814 DM |
122 | # RT #88774 |
123 | # make sure the signal handler's called in an eval block *before* | |
124 | # the eval is popped | |
125 | ||
126 | $SIG{'ALRM'} = sub { die "HANDLER CALLED\n" }; | |
127 | ||
128 | eval { | |
129 | alarm(2); | |
130 | select(undef,undef,undef,10); | |
131 | }; | |
132 | alarm(0); | |
133 | is($@, "HANDLER CALLED\n", 'block eval'); | |
134 | ||
135 | eval q{ | |
136 | alarm(2); | |
137 | select(undef,undef,undef,10); | |
138 | }; | |
139 | alarm(0); | |
140 | is($@, "HANDLER CALLED\n", 'string eval'); | |
141 | } | |
84c7b88c BF |
142 | |
143 | eval { $SIG{"__WARN__\0"} = sub { 1 } }; | |
144 | like $@, qr/No such hook: __WARN__\\0 at/, q!Fetching %SIG hooks with an extra trailing nul is nul-clean!; | |
145 | ||
146 | eval { $SIG{"__DIE__\0whoops"} = sub { 1 } }; | |
147 | like $@, qr/No such hook: __DIE__\\0whoops at/; | |
148 | ||
149 | { | |
150 | use warnings; | |
151 | my $w; | |
152 | local $SIG{__WARN__} = sub { $w = shift }; | |
153 | ||
154 | $SIG{"KILL\0"} = sub { 1 }; | |
155 | like $w, qr/No such signal: SIGKILL\\0 at/, 'Arbitrary signal lookup through %SIG is clean'; | |
156 | } | |
100c03aa JL |
157 | |
158 | # [perl #45173] | |
159 | { | |
6281d426 TC |
160 | my $int_called; |
161 | local $SIG{INT} = sub { $int_called = 1; }; | |
100c03aa JL |
162 | $@ = "died"; |
163 | is($@, "died"); | |
6281d426 TC |
164 | kill 'INT', $$; |
165 | # this is needed to ensure signal delivery on MSWin32 | |
166 | sleep(1); | |
167 | is($int_called, 1); | |
100c03aa JL |
168 | is($@, "died"); |
169 | } |