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 }