ext/POSIX/t/sigaction.t

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