Commit | Line | Data |
---|---|---|
8f3964af NC |
1 | #!perl -w |
2 | ||
3 | # We assume that TestInit has been used. | |
4 | ||
5 | BEGIN { | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
9 | use strict; | |
0c1bf4c7 | 10 | use Config; |
8f3964af | 11 | |
84c7b88c | 12 | plan tests => 26; |
8f3964af | 13 | |
011c3814 | 14 | watchdog(15); |
8f3964af NC |
15 | |
16 | $SIG{ALRM} = sub { | |
17 | die "Alarm!\n"; | |
18 | }; | |
19 | ||
20 | pass('before the first loop'); | |
21 | ||
22 | alarm 2; | |
23 | ||
24 | eval { | |
25 | 1 while 1; | |
26 | }; | |
27 | ||
28 | is($@, "Alarm!\n", 'after the first loop'); | |
29 | ||
30 | pass('before the second loop'); | |
31 | ||
32 | alarm 2; | |
33 | ||
34 | eval { | |
35 | while (1) { | |
36 | } | |
37 | }; | |
38 | ||
39 | is($@, "Alarm!\n", 'after the second loop'); | |
0c1bf4c7 LT |
40 | |
41 | SKIP: { | |
61fb63a6 | 42 | skip('We can\'t test blocking without sigprocmask', 17) |
b93d0e62 | 43 | if is_miniperl() || !$Config{d_sigprocmask}; |
61fb63a6 | 44 | skip('This doesn\'t work on OpenBSD threaded builds RT#88814', 17) |
2cf7ccf4 | 45 | if $^O eq 'openbsd' && $Config{useithreads}; |
0c1bf4c7 LT |
46 | |
47 | require POSIX; | |
61fb63a6 NC |
48 | my $pending = POSIX::SigSet->new(); |
49 | is POSIX::sigpending($pending), '0 but true', 'sigpending'; | |
50 | is $pending->ismember(&POSIX::SIGUSR1), 0, 'SIGUSR1 is not pending'; | |
0c1bf4c7 LT |
51 | my $new = POSIX::SigSet->new(&POSIX::SIGUSR1); |
52 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, $new); | |
53 | ||
54 | my $gotit = 0; | |
55 | $SIG{USR1} = sub { $gotit++ }; | |
eb796c7f | 56 | kill 'SIGUSR1', $$; |
7fe50b8b | 57 | is $gotit, 0, 'Haven\'t received third signal yet'; |
61fb63a6 NC |
58 | is POSIX::sigpending($pending), '0 but true', 'sigpending'; |
59 | is $pending->ismember(&POSIX::SIGUSR1), 1, 'SIGUSR1 is pending'; | |
0c1bf4c7 LT |
60 | |
61 | my $old = POSIX::SigSet->new(); | |
62 | POSIX::sigsuspend($old); | |
63 | is $gotit, 1, 'Received third signal'; | |
61fb63a6 NC |
64 | is POSIX::sigpending($pending), '0 but true', 'sigpending'; |
65 | is $pending->ismember(&POSIX::SIGUSR1), 0, 'SIGUSR1 is no longer pending'; | |
0c1bf4c7 | 66 | |
7fe50b8b | 67 | { |
eb796c7f | 68 | kill 'SIGUSR1', $$; |
7fe50b8b LT |
69 | local $SIG{USR1} = sub { die "FAIL\n" }; |
70 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old); | |
71 | ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is blocked'; | |
72 | eval { POSIX::sigsuspend(POSIX::SigSet->new) }; | |
73 | is $@, "FAIL\n", 'Exception is thrown, so received fourth signal'; | |
74 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old); | |
23292af3 CB |
75 | TODO: |
76 | { | |
77 | local $::TODO = "Needs investigation" if $^O eq 'VMS'; | |
7fe50b8b | 78 | ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is still blocked'; |
23292af3 | 79 | } |
7fe50b8b LT |
80 | } |
81 | ||
554bc0f4 | 82 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, $new); |
eb796c7f | 83 | kill 'SIGUSR1', $$; |
554bc0f4 LT |
84 | is $gotit, 1, 'Haven\'t received fifth signal yet'; |
85 | POSIX::sigprocmask(&POSIX::SIG_UNBLOCK, $new, $old); | |
86 | ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 was still blocked'; | |
7fe50b8b | 87 | is $gotit, 2, 'Received fifth signal'; |
c22d665b LT |
88 | |
89 | # test unsafe signal handlers in combination with exceptions | |
90 | my $action = POSIX::SigAction->new(sub { $gotit--, die }, POSIX::SigSet->new, 0); | |
28fcd422 | 91 | POSIX::sigaction(&POSIX::SIGALRM, $action); |
b3dbdd48 LT |
92 | eval { |
93 | alarm 1; | |
94 | my $set = POSIX::SigSet->new; | |
95 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $set); | |
96 | is $set->ismember(&POSIX::SIGALRM), 0, "SIGALRM is not blocked on attempt $_"; | |
97 | POSIX::sigsuspend($set); | |
98 | } for 1..2; | |
c22d665b | 99 | is $gotit, 0, 'Received both signals'; |
0c1bf4c7 | 100 | } |
011c3814 | 101 | |
476c37e2 NC |
102 | SKIP: { |
103 | skip("alarm cannot interrupt blocking system calls on $^O", 2) | |
31ba48ca | 104 | if ($^O eq 'MSWin32' || $^O eq 'VMS'); |
011c3814 DM |
105 | # RT #88774 |
106 | # make sure the signal handler's called in an eval block *before* | |
107 | # the eval is popped | |
108 | ||
109 | $SIG{'ALRM'} = sub { die "HANDLER CALLED\n" }; | |
110 | ||
111 | eval { | |
112 | alarm(2); | |
113 | select(undef,undef,undef,10); | |
114 | }; | |
115 | alarm(0); | |
116 | is($@, "HANDLER CALLED\n", 'block eval'); | |
117 | ||
118 | eval q{ | |
119 | alarm(2); | |
120 | select(undef,undef,undef,10); | |
121 | }; | |
122 | alarm(0); | |
123 | is($@, "HANDLER CALLED\n", 'string eval'); | |
124 | } | |
84c7b88c BF |
125 | |
126 | eval { $SIG{"__WARN__\0"} = sub { 1 } }; | |
127 | like $@, qr/No such hook: __WARN__\\0 at/, q!Fetching %SIG hooks with an extra trailing nul is nul-clean!; | |
128 | ||
129 | eval { $SIG{"__DIE__\0whoops"} = sub { 1 } }; | |
130 | like $@, qr/No such hook: __DIE__\\0whoops at/; | |
131 | ||
132 | { | |
133 | use warnings; | |
134 | my $w; | |
135 | local $SIG{__WARN__} = sub { $w = shift }; | |
136 | ||
137 | $SIG{"KILL\0"} = sub { 1 }; | |
138 | like $w, qr/No such signal: SIGKILL\\0 at/, 'Arbitrary signal lookup through %SIG is clean'; | |
139 | } |