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