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 'VMS' && !$Config{'d_sigaction'})) {
  13                 print "1..0\n";
  14                 exit 0;
  15         }
  16 }
  17
  18 use strict;
  19 use vars qw/$bad7 $ok10 $bad18 $ok/;
  20
  21 $^W=1;
  22
  23 print "1..18\n";
  24
  25 sub IGNORE {
  26         $bad7=1;
  27 }
  28
  29 sub DEFAULT {
  30         $bad18=1;
  31 }
  32
  33 sub foo {
  34         $ok=1;
  35 }
  36
  37 my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
  38 my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
  39
  40 {
  41         my $bad;
  42         local($SIG{__WARN__})=sub { $bad=1; };
  43         sigaction(SIGHUP, $newaction, $oldaction);
  44         if($bad) { print "not ok 1\n" } else { print "ok 1\n"}
  45 }
  46
  47 if($oldaction->{HANDLER} eq 'DEFAULT' ||
  48    $oldaction->{HANDLER} eq 'IGNORE')
  49   { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"}
  50 print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n";
  51
  52 sigaction(SIGHUP, $newaction, $oldaction);
  53 if($oldaction->{HANDLER} eq '::foo')
  54   { print "ok 4\n" } else { print "not ok 4\n"}
  55 if($oldaction->{MASK}->ismember(SIGUSR1))
  56   { print "ok 5\n" } else { print "not ok 5\n"}
  57 if($oldaction->{FLAGS}) {
  58     if ($^O eq 'linux' || $^O eq 'unicos') {
  59         print "ok 6 # Skip: sigaction() thinks different in $^O\n";
  60     } else {
  61         print "not ok 6\n";
  62     }
  63 } else {
  64     print "ok 6\n";
  65 }
  66
  67 $newaction=POSIX::SigAction->new('IGNORE');
  68 sigaction(SIGHUP, $newaction);
  69 kill 'HUP', $$;
  70 print $bad7 ? "not ok 7\n" : "ok 7\n";
  71
  72 print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n";
  73 sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
  74 print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n";
  75
  76 $newaction=POSIX::SigAction->new(sub { $ok10=1; });
  77 sigaction(SIGHUP, $newaction);
  78 {
  79         local($^W)=0;
  80         kill 'HUP', $$;
  81 }
  82 print $ok10 ? "ok 10\n" : "not ok 10\n";
  83
  84 print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n";
  85
  86 sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
  87 # Make sure the signal mask gets restored after sigaction croak()s.
  88 eval {
  89         my $act=POSIX::SigAction->new('::foo');
  90         delete $act->{HANDLER};
  91         sigaction(SIGINT, $act);
  92 };
  93 kill 'HUP', $$;
  94 print $ok ? "ok 12\n" : "not ok 12\n";
  95
  96 undef $ok;
  97 # Make sure the signal mask gets restored after sigaction returns early.
  98 my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
  99 kill 'HUP', $$;
 100 print !$x && $ok ? "ok 13\n" : "not ok 13\n";
 101
 102 $SIG{HUP}=sub {};
 103 sigaction(SIGHUP, $newaction, $oldaction);
 104 print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n";
 105
 106 eval {
 107         sigaction(SIGHUP, undef, $oldaction);
 108 };
 109 print $@ ? "not ok 15\n" : "ok 15\n";
 110
 111 eval {
 112         sigaction(SIGHUP, 0, $oldaction);
 113 };
 114 print $@ ? "not ok 16\n" : "ok 16\n";
 115
 116 eval {
 117         sigaction(SIGHUP, bless({},'Class'), $oldaction);
 118 };
 119 print $@ ? "ok 17\n" : "not ok 17\n";
 120
 121 if ($^O eq 'VMS') {
 122     print "ok 18 # Skip: SIGCONT not trappable in $^O\n";
 123 } else {
 124     $newaction=POSIX::SigAction->new(sub { $ok10=1; });
 125     if (eval { SIGCONT; 1 }) {
 126         sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
 127         {
 128             local($^W)=0;
 129             kill 'CONT', $$;
 130         }
 131     }
 132     print $bad18 ? "not ok 18\n" : "ok 18\n";
 133 }
 134