This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix pod warning for empty sections.
[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
0c1bf4c7 12plan tests => 9;
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: {
42 skip('We can\'t test blocking without sigprocmask', 3) 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 third received signal yet';
52
53 my $old = POSIX::SigSet->new();
54 POSIX::sigsuspend($old);
55 is $gotit, 1, 'Received third signal';
56
57 kill SIGUSR1, $$;
58 is $gotit, 1, 'Haven\'t fourth received signal yet';
59 POSIX::sigprocmask(&POSIX::SIG_UNBLOCK, $new, $old);
60 ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 was still blocked';
61 is $gotit, 2, 'Received fourth signal';
62}