ext/POSIX/t/sigaction.t

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