ext/POSIX/t/sigaction.t

   1 #!./perl
   2
   3 use Test::More tests => 29;
   4
   5 BEGIN {
   6         chdir 't' if -d 't';
   7         unshift @INC, '../lib';
   8 }
   9
  10 BEGIN{
  11         # Don't do anything if POSIX is missing, or sigaction missing.
  12         use Config;
  13         eval 'use POSIX';
  14         if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' ||
  15            $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) {
  16                 print "1..0\n";
  17                 exit 0;
  18         }
  19 }
  20
  21 use strict;
  22 use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
  23
  24 $^W=1;
  25
  26 sub IGNORE {
  27         $bad7=1;
  28 }
  29
  30 sub DEFAULT {
  31         $bad18=1;
  32 }
  33
  34 sub foo {
  35         $ok=1;
  36 }
  37
  38 my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
  39 my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
  40
  41 {
  42         my $bad;
  43         local($SIG{__WARN__})=sub { $bad=1; };
  44         sigaction(SIGHUP, $newaction, $oldaction);
  45         ok(!$bad, "no warnings");
  46 }
  47
  48 ok($oldaction->{HANDLER} eq 'DEFAULT' ||
  49    $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER});
  50
  51 is($SIG{HUP}, '::foo');
  52
  53 sigaction(SIGHUP, $newaction, $oldaction);
  54 is($oldaction->{HANDLER}, '::foo');
  55
  56 ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK");
  57
  58 SKIP: {
  59     skip("sigaction() thinks different in $^O", 1)
  60         if $^O eq 'linux' || $^O eq 'unicos';
  61     is($oldaction->{FLAGS}, 0);
  62 }
  63
  64 $newaction=POSIX::SigAction->new('IGNORE');
  65 sigaction(SIGHUP, $newaction);
  66 kill 'HUP', $$;
  67 ok(!$bad, "SIGHUP ignored");
  68
  69 is($SIG{HUP}, 'IGNORE');
  70 sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
  71 is($SIG{HUP}, 'DEFAULT');
  72
  73 $newaction=POSIX::SigAction->new(sub { $ok10=1; });
  74 sigaction(SIGHUP, $newaction);
  75 {
  76         local($^W)=0;
  77         kill 'HUP', $$;
  78 }
  79 ok($ok10, "SIGHUP handler called");
  80
  81 is(ref($SIG{HUP}), 'CODE');
  82
  83 sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
  84 # Make sure the signal mask gets restored after sigaction croak()s.
  85 eval {
  86         my $act=POSIX::SigAction->new('::foo');
  87         delete $act->{HANDLER};
  88         sigaction(SIGINT, $act);
  89 };
  90 kill 'HUP', $$;
  91 ok($ok, "signal mask gets restored after croak");
  92
  93 undef $ok;
  94 # Make sure the signal mask gets restored after sigaction returns early.
  95 my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
  96 kill 'HUP', $$;
  97 ok(!$x && $ok, "signal mask gets restored after early return");
  98
  99 $SIG{HUP}=sub {};
 100 sigaction(SIGHUP, $newaction, $oldaction);
 101 is(ref($oldaction->{HANDLER}), 'CODE');
 102
 103 eval {
 104         sigaction(SIGHUP, undef, $oldaction);
 105 };
 106 ok(!$@, "undef for new action");
 107
 108 eval {
 109         sigaction(SIGHUP, 0, $oldaction);
 110 };
 111 ok(!$@, "zero for new action");
 112
 113 eval {
 114         sigaction(SIGHUP, bless({},'Class'), $oldaction);
 115 };
 116 ok($@, "any object not good as new action");
 117
 118 SKIP: {
 119     skip("SIGCONT not trappable in $^O", 1)
 120         if ($^O eq 'VMS');
 121     $newaction=POSIX::SigAction->new(sub { $ok10=1; });
 122     if (eval { SIGCONT; 1 }) {
 123         sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
 124         {
 125             local($^W)=0;
 126             kill 'CONT', $$;
 127         }
 128     }
 129     ok(!$bad18, "SIGCONT trappable");
 130 }
 131
 132 {
 133     local $SIG{__WARN__} = sub { }; # Just suffer silently.
 134
 135     my $hup20;
 136     my $hup21;
 137
 138     sub hup20 { $hup20++ }
 139     sub hup21 { $hup21++ }
 140
 141     sigaction("FOOBAR", $newaction);
 142     ok(1, "no coredump, still alive");
 143
 144     $newaction = POSIX::SigAction->new("hup20");
 145     sigaction("SIGHUP", $newaction);
 146     kill "HUP", $$;
 147     is($hup20, 1);
 148
 149     $newaction = POSIX::SigAction->new("hup21");
 150     sigaction("HUP", $newaction);
 151     kill "HUP", $$;
 152     is ($hup21, 1);
 153 }
 154
 155 # "safe" attribute.
 156 # for this one, use the accessor instead of the attribute
 157
 158 # standard signal handling via %SIG is safe
 159 $SIG{HUP} = \&foo;
 160 $oldaction = POSIX::SigAction->new;
 161 sigaction(SIGHUP, undef, $oldaction);
 162 ok($oldaction->safe, "SIGHUP is safe");
 163
 164 # SigAction handling is not safe ...
 165 sigaction(SIGHUP, POSIX::SigAction->new(\&foo));
 166 sigaction(SIGHUP, undef, $oldaction);
 167 ok(!$oldaction->safe, "SigAction not safe by default");
 168
 169 # ... unless we say so!
 170 $newaction = POSIX::SigAction->new(\&foo);
 171 $newaction->safe(1);
 172 sigaction(SIGHUP, $newaction);
 173 sigaction(SIGHUP, undef, $oldaction);
 174 ok($oldaction->safe, "SigAction can be safe");
 175
 176 # And safe signal delivery must work
 177 $ok = 0;
 178 kill 'HUP', $$;
 179 ok($ok, "safe signal delivery must work");
 180
 181 SKIP: {
 182     eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX)';
 183     skip("no SIGRT signals", 4) if $@;
 184     ok(SIGRTMAX > SIGRTMIN, "SIGRTMAX > SIGRTMIN");
 185     is(scalar %SIGRT, SIGRTMAX() - SIGRTMIN() + 1, "scalar SIGRT");
 186     my $sigrtmin;
 187     my $h = sub { $sigrtmin = 1 };
 188     $SIGRT{SIGRTMIN} = $h;
 189     is($SIGRT{SIGRTMIN}, $h, "handler set & get");
 190     kill 'SIGRTMIN', $$;
 191     is($sigrtmin, 1, "SIGRTMIN handler works");
 192 }