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 | |
011c3814 | 12 | plan tests => 17; |
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: { | |
b93d0e62 NC |
42 | skip('We can\'t test blocking without sigprocmask', 11) |
43 | if is_miniperl() || !$Config{d_sigprocmask}; | |
2cf7ccf4 TC |
44 | skip('This doesn\'t work on OpenBSD threaded builds RT#88814', 11) |
45 | if $^O eq 'openbsd' && $Config{useithreads}; | |
0c1bf4c7 LT |
46 | |
47 | require POSIX; | |
48 | my $new = POSIX::SigSet->new(&POSIX::SIGUSR1); | |
49 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, $new); | |
50 | ||
51 | my $gotit = 0; | |
52 | $SIG{USR1} = sub { $gotit++ }; | |
53 | kill SIGUSR1, $$; | |
7fe50b8b | 54 | is $gotit, 0, 'Haven\'t received third signal yet'; |
0c1bf4c7 LT |
55 | |
56 | my $old = POSIX::SigSet->new(); | |
57 | POSIX::sigsuspend($old); | |
58 | is $gotit, 1, 'Received third signal'; | |
59 | ||
7fe50b8b LT |
60 | { |
61 | kill SIGUSR1, $$; | |
62 | local $SIG{USR1} = sub { die "FAIL\n" }; | |
63 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old); | |
64 | ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is blocked'; | |
65 | eval { POSIX::sigsuspend(POSIX::SigSet->new) }; | |
66 | is $@, "FAIL\n", 'Exception is thrown, so received fourth signal'; | |
67 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old); | |
23292af3 CB |
68 | TODO: |
69 | { | |
70 | local $::TODO = "Needs investigation" if $^O eq 'VMS'; | |
7fe50b8b | 71 | ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is still blocked'; |
23292af3 | 72 | } |
7fe50b8b LT |
73 | } |
74 | ||
554bc0f4 LT |
75 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, $new); |
76 | kill SIGUSR1, $$; | |
77 | is $gotit, 1, 'Haven\'t received fifth signal yet'; | |
78 | POSIX::sigprocmask(&POSIX::SIG_UNBLOCK, $new, $old); | |
79 | ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 was still blocked'; | |
7fe50b8b | 80 | is $gotit, 2, 'Received fifth signal'; |
c22d665b LT |
81 | |
82 | # test unsafe signal handlers in combination with exceptions | |
83 | my $action = POSIX::SigAction->new(sub { $gotit--, die }, POSIX::SigSet->new, 0); | |
28fcd422 | 84 | POSIX::sigaction(&POSIX::SIGALRM, $action); |
b3dbdd48 LT |
85 | eval { |
86 | alarm 1; | |
87 | my $set = POSIX::SigSet->new; | |
88 | POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $set); | |
89 | is $set->ismember(&POSIX::SIGALRM), 0, "SIGALRM is not blocked on attempt $_"; | |
90 | POSIX::sigsuspend($set); | |
91 | } for 1..2; | |
c22d665b | 92 | is $gotit, 0, 'Received both signals'; |
0c1bf4c7 | 93 | } |
011c3814 | 94 | |
476c37e2 NC |
95 | SKIP: { |
96 | skip("alarm cannot interrupt blocking system calls on $^O", 2) | |
31ba48ca | 97 | if ($^O eq 'MSWin32' || $^O eq 'VMS'); |
011c3814 DM |
98 | # RT #88774 |
99 | # make sure the signal handler's called in an eval block *before* | |
100 | # the eval is popped | |
101 | ||
102 | $SIG{'ALRM'} = sub { die "HANDLER CALLED\n" }; | |
103 | ||
104 | eval { | |
105 | alarm(2); | |
106 | select(undef,undef,undef,10); | |
107 | }; | |
108 | alarm(0); | |
109 | is($@, "HANDLER CALLED\n", 'block eval'); | |
110 | ||
111 | eval q{ | |
112 | alarm(2); | |
113 | select(undef,undef,undef,10); | |
114 | }; | |
115 | alarm(0); | |
116 | is($@, "HANDLER CALLED\n", 'string eval'); | |
117 | } |