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 => 36;
  15
  16 use strict;
  17 use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
  18
  19 $^W=1;
  20
  21 sub IGNORE {
  22     ++$bad7;
  23 }
  24
  25 sub DEFAULT {
  26     ++$bad18;
  27 }
  28
  29 sub foo {
  30     ++$ok;
  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         is($bad, undef, "no warnings");
  41 }
  42
  43 like($oldaction->{HANDLER}, qr/\A(?:DEFAULT|IGNORE)\z/, '$oldaction->{HANDLER}');
  44
  45 is($SIG{HUP}, '::foo');
  46
  47 sigaction(SIGHUP, $newaction, $oldaction);
  48 is($oldaction->{HANDLER}, '::foo');
  49
  50 ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK");
  51
  52 SKIP: {
  53     skip("sigaction() thinks different in $^O", 1)
  54         if $^O eq 'linux' || $^O eq 'unicos';
  55     is($oldaction->{FLAGS}, 0);
  56 }
  57
  58 $newaction=POSIX::SigAction->new('IGNORE');
  59 sigaction(SIGHUP, $newaction);
  60 kill 'HUP', $$;
  61 is($bad, undef, "SIGHUP ignored");
  62
  63 is($SIG{HUP}, 'IGNORE');
  64 sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
  65 is($SIG{HUP}, 'DEFAULT');
  66
  67 $newaction=POSIX::SigAction->new(sub { ++$ok10; });
  68 sigaction(SIGHUP, $newaction);
  69 {
  70         local($^W)=0;
  71         kill 'HUP', $$;
  72 }
  73 is($ok10, 1, "SIGHUP handler called");
  74
  75 is(ref($SIG{HUP}), 'CODE');
  76
  77 sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
  78 # Make sure the signal mask gets restored after sigaction croak()s.
  79 eval {
  80         my $act=POSIX::SigAction->new('::foo');
  81         delete $act->{HANDLER};
  82         sigaction(SIGINT, $act);
  83 };
  84 kill 'HUP', $$;
  85 is($ok, 1, "signal mask gets restored after croak");
  86
  87 undef $ok;
  88 # Make sure the signal mask gets restored after sigaction returns early.
  89 my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
  90 kill 'HUP', $$;
  91 is($x, '', "signal mask gets restored after early return");
  92 is($ok, 1, "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 is($@, '', "undef for new action");
 102
 103 eval {
 104         sigaction(SIGHUP, 0, $oldaction);
 105 };
 106 is($@, '', "zero for new action");
 107
 108 eval {
 109         sigaction(SIGHUP, bless({},'Class'), $oldaction);
 110 };
 111 like($@, qr/\Aaction is not of type POSIX::SigAction/,
 112      'any object not good as new action');
 113
 114 SKIP: {
 115     skip("SIGCONT not trappable in $^O", 1)
 116         if ($^O eq 'VMS');
 117     $newaction=POSIX::SigAction->new(sub { ++$ok10; });
 118     if (eval { SIGCONT; 1 }) {
 119         sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
 120         {
 121             local($^W)=0;
 122             kill 'CONT', $$;
 123         }
 124     }
 125     is($bad18, undef, "SIGCONT trappable");
 126 }
 127
 128 {
 129     local $SIG{__WARN__} = sub { }; # Just suffer silently.
 130
 131     my $hup20;
 132     my $hup21;
 133
 134     sub hup20 { $hup20++ }
 135     sub hup21 { $hup21++ }
 136
 137     sigaction("FOOBAR", $newaction);
 138     pass("no coredump, still alive");
 139
 140     $newaction = POSIX::SigAction->new("hup20");
 141     sigaction("SIGHUP", $newaction);
 142     kill "HUP", $$;
 143     is($hup20, 1);
 144
 145     $newaction = POSIX::SigAction->new("hup21");
 146     sigaction("HUP", $newaction);
 147     kill "HUP", $$;
 148     is ($hup21, 1);
 149 }
 150
 151 # "safe" attribute.
 152 # for this one, use the accessor instead of the attribute
 153
 154 # standard signal handling via %SIG is safe
 155 $SIG{HUP} = \&foo;
 156 $oldaction = POSIX::SigAction->new;
 157 sigaction(SIGHUP, undef, $oldaction);
 158 ok($oldaction->safe, "SIGHUP is safe");
 159
 160 # SigAction handling is not safe ...
 161 sigaction(SIGHUP, POSIX::SigAction->new(\&foo));
 162 sigaction(SIGHUP, undef, $oldaction);
 163 ok(!$oldaction->safe, "SigAction not safe by default");
 164
 165 # ... unless we say so!
 166 $newaction = POSIX::SigAction->new(\&foo);
 167 $newaction->safe(1);
 168 sigaction(SIGHUP, $newaction);
 169 sigaction(SIGHUP, undef, $oldaction);
 170 ok($oldaction->safe, "SigAction can be safe");
 171
 172 # And safe signal delivery must work
 173 $ok = 0;
 174 kill 'HUP', $$;
 175 is($ok, 1, "safe signal delivery must work");
 176
 177 SKIP: {
 178     eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX); scalar %SIGRT + SIGRTMIN() + SIGRTMAX()';
 179     $@                                  # POSIX did not exort
 180     || SIGRTMIN() < 0 || SIGRTMAX() < 0 # HP-UX 10.20 exports both as -1
 181     || SIGRTMIN() > $Config{sig_count}  # AIX 4.3.3 exports bogus 888 and 999
 182         and skip("no SIGRT signals", 4);
 183     cmp_ok(SIGRTMAX(), '>', SIGRTMIN(), "SIGRTMAX > SIGRTMIN");
 184     is(scalar %SIGRT, SIGRTMAX() - SIGRTMIN() + 1, "scalar SIGRT");
 185     my $sigrtmin;
 186     my $h = sub { $sigrtmin = 1 };
 187     $SIGRT{SIGRTMIN} = $h;
 188     is($SIGRT{SIGRTMIN}, $h, "handler set & get");
 189     kill 'SIGRTMIN', $$;
 190     is($sigrtmin, 1, "SIGRTMIN handler works");
 191 }
 192
 193 SKIP: {
 194     my %siginfo = (
 195         signo => SIGHUP,
 196         pid => $$,
 197         uid => $<,
 198     );
 199     my %opt_val = ( code => 'SI_USER' );
 200     my %always = map +($_ => 1), qw(signo code);
 201     my %skip = ( code => { darwin => "not set to SI_USER for kill()" } );
 202     my $tests = keys %{{ %siginfo, %opt_val }};
 203     eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO';
 204     skip("no SA_SIGINFO", $tests) if $@;
 205     skip("SA_SIGINFO is broken on AIX 4.2", $tests) if ($^O.$Config{osvers}) =~ m/^aix4\.2/;
 206     skip("SA_SIGINFO is broken on os390", $tests) if ($^O.$Config{osvers}) =~ m/os390/;
 207     eval "use POSIX qw($opt_val{$_}); \$siginfo{$_} = $opt_val{$_}"
 208         for keys %opt_val;
 209     sub hiphup {
 210         for my $field (sort keys %{{ %siginfo, %opt_val }}) {
 211             SKIP: {
 212                 skip("siginfo_t has no $field field", 1)
 213                     unless %always{$field} or ($Config{"d_siginfo_si_$field"} || '') eq 'define';
 214                 skip("no constant defined for SA_SIGINFO $field value $opt_val{$field}", 1)
 215                     unless defined $siginfo{$field};
 216                 skip("SA_SIGINFO $field value is wrong on $^O: $skip{$field}{$^O}", 1)
 217                     if $skip{$field}{$^O};
 218                 is($_[1]->{$field}, $siginfo{$field}, "SA_SIGINFO got right $field")
 219             }
 220         }
 221     }
 222     my $act = POSIX::SigAction->new('hiphup', 0, SA_SIGINFO);
 223     sigaction(SIGHUP, $act);
 224     kill 'HUP', $$;
 225 }
 226
 227 eval { sigaction(-999, "foo"); };
 228 like($@, qr/Negative signals/,
 229     "Prevent negative signals instead of core dumping");
 230
 231 # RT 77432 - assertion failure with POSIX::SigAction
 232 {
 233   local *SIG = {};
 234   ok(sigaction(SIGHUP, POSIX::SigAction->new),
 235      "sigaction would crash/assert with a replaced %SIG");
 236 }