| 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 |
|
|---|
|
|---|