This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Missing bug number in d12b49d
[perl5.git] / t / op / sigdispatch.t
CommitLineData
8f3964af
NC
1#!perl -w
2
3# We assume that TestInit has been used.
4
5BEGIN {
6 require './test.pl';
7}
8
9use strict;
0c1bf4c7 10use Config;
8f3964af 11
b3dbdd48 12plan tests => 15;
8f3964af
NC
13
14watchdog(10);
15
16$SIG{ALRM} = sub {
17 die "Alarm!\n";
18};
19
20pass('before the first loop');
21
22alarm 2;
23
24eval {
25 1 while 1;
26};
27
28is($@, "Alarm!\n", 'after the first loop');
29
30pass('before the second loop');
31
32alarm 2;
33
34eval {
35 while (1) {
36 }
37};
38
39is($@, "Alarm!\n", 'after the second loop');
0c1bf4c7
LT
40
41SKIP: {
b93d0e62
NC
42 skip('We can\'t test blocking without sigprocmask', 11)
43 if is_miniperl() || !$Config{d_sigprocmask};
0c1bf4c7
LT
44
45 require POSIX;
46 my $new = POSIX::SigSet->new(&POSIX::SIGUSR1);
47 POSIX::sigprocmask(&POSIX::SIG_BLOCK, $new);
48
49 my $gotit = 0;
50 $SIG{USR1} = sub { $gotit++ };
51 kill SIGUSR1, $$;
7fe50b8b 52 is $gotit, 0, 'Haven\'t received third signal yet';
0c1bf4c7
LT
53
54 my $old = POSIX::SigSet->new();
55 POSIX::sigsuspend($old);
56 is $gotit, 1, 'Received third signal';
57
7fe50b8b
LT
58 {
59 kill SIGUSR1, $$;
60 local $SIG{USR1} = sub { die "FAIL\n" };
61 POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old);
62 ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is blocked';
63 eval { POSIX::sigsuspend(POSIX::SigSet->new) };
64 is $@, "FAIL\n", 'Exception is thrown, so received fourth signal';
65 POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old);
23292af3
CB
66TODO:
67 {
68 local $::TODO = "Needs investigation" if $^O eq 'VMS';
7fe50b8b 69 ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is still blocked';
23292af3 70 }
7fe50b8b
LT
71 }
72
23292af3
CB
73TODO:
74 {
75 local $::TODO = "Needs investigation" if $^O eq 'VMS';
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';
80 }
7fe50b8b 81 is $gotit, 2, 'Received fifth signal';
c22d665b
LT
82
83 # test unsafe signal handlers in combination with exceptions
84 my $action = POSIX::SigAction->new(sub { $gotit--, die }, POSIX::SigSet->new, 0);
28fcd422 85 POSIX::sigaction(&POSIX::SIGALRM, $action);
b3dbdd48
LT
86 eval {
87 alarm 1;
88 my $set = POSIX::SigSet->new;
89 POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $set);
90 is $set->ismember(&POSIX::SIGALRM), 0, "SIGALRM is not blocked on attempt $_";
91 POSIX::sigsuspend($set);
92 } for 1..2;
c22d665b 93 is $gotit, 0, 'Received both signals';
0c1bf4c7 94}