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