This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Detect unsafe signals more reliably on BSD/Solaris
[perl5.git] / t / op / sigdispatch.t
1 #!perl -w
2
3 # We assume that TestInit has been used.
4
5 BEGIN {
6       require './test.pl';
7 }
8
9 use strict;
10 use Config;
11
12 plan tests => 15;
13
14 watchdog(10);
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');
40
41 SKIP: {
42     skip('We can\'t test blocking without sigprocmask', 11) if $ENV{PERL_CORE_MINITEST} || !$Config{d_sigprocmask};
43
44     require POSIX;
45     my $new = POSIX::SigSet->new(&POSIX::SIGUSR1);
46     POSIX::sigprocmask(&POSIX::SIG_BLOCK, $new);
47     
48     my $gotit = 0;
49     $SIG{USR1} = sub { $gotit++ };
50     kill SIGUSR1, $$;
51     is $gotit, 0, 'Haven\'t received third signal yet';
52     
53     my $old = POSIX::SigSet->new();
54     POSIX::sigsuspend($old);
55     is $gotit, 1, 'Received third signal';
56     
57         {
58                 kill SIGUSR1, $$;
59                 local $SIG{USR1} = sub { die "FAIL\n" };
60                 POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old);
61                 ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is blocked';
62                 eval { POSIX::sigsuspend(POSIX::SigSet->new) };
63                 is $@, "FAIL\n", 'Exception is thrown, so received fourth signal';
64                 POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old);
65                 ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is still blocked';
66         }
67
68     kill SIGUSR1, $$;
69     is $gotit, 1, 'Haven\'t received fifth signal yet';
70     POSIX::sigprocmask(&POSIX::SIG_UNBLOCK, $new, $old);
71     ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 was still blocked';
72     is $gotit, 2, 'Received fifth signal';
73
74     # test unsafe signal handlers in combination with exceptions
75     my $action = POSIX::SigAction->new(sub { $gotit--, die }, POSIX::SigSet->new, 0);
76     POSIX::sigaction(&POSIX::SIGALRM, $action);
77     eval {
78         alarm 1;
79         my $set = POSIX::SigSet->new;
80         POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $set);
81         is $set->ismember(&POSIX::SIGALRM), 0, "SIGALRM is not blocked on attempt $_";
82         POSIX::sigsuspend($set);
83     } for 1..2;
84     is $gotit, 0, 'Received both signals';
85 }