1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 unshift @INC, '../lib'; 6} 7 8BEGIN{ 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 19use strict; 20use vars qw/$bad7 $ok10 $bad18 $ok/; 21 22$^W=1; 23 24print "1..25\n"; 25 26sub IGNORE { 27 $bad7=1; 28} 29 30sub DEFAULT { 31 $bad18=1; 32} 33 34sub foo { 35 $ok=1; 36} 37 38my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0); 39my $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 48if($oldaction->{HANDLER} eq 'DEFAULT' || 49 $oldaction->{HANDLER} eq 'IGNORE') 50 { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"} 51print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n"; 52 53sigaction(SIGHUP, $newaction, $oldaction); 54if($oldaction->{HANDLER} eq '::foo') 55 { print "ok 4\n" } else { print "not ok 4\n"} 56if($oldaction->{MASK}->ismember(SIGUSR1)) 57 { print "ok 5\n" } else { print "not ok 5\n"} 58if($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'); 69sigaction(SIGHUP, $newaction); 70kill 'HUP', $$; 71print $bad7 ? "not ok 7\n" : "ok 7\n"; 72 73print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n"; 74sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT')); 75print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n"; 76 77$newaction=POSIX::SigAction->new(sub { $ok10=1; }); 78sigaction(SIGHUP, $newaction); 79{ 80 local($^W)=0; 81 kill 'HUP', $$; 82} 83print $ok10 ? "ok 10\n" : "not ok 10\n"; 84 85print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n"; 86 87sigaction(SIGHUP, POSIX::SigAction->new('::foo')); 88# Make sure the signal mask gets restored after sigaction croak()s. 89eval { 90 my $act=POSIX::SigAction->new('::foo'); 91 delete $act->{HANDLER}; 92 sigaction(SIGINT, $act); 93}; 94kill 'HUP', $$; 95print $ok ? "ok 12\n" : "not ok 12\n"; 96 97undef $ok; 98# Make sure the signal mask gets restored after sigaction returns early. 99my $x=defined sigaction(SIGKILL, $newaction, $oldaction); 100kill 'HUP', $$; 101print !$x && $ok ? "ok 13\n" : "not ok 13\n"; 102 103$SIG{HUP}=sub {}; 104sigaction(SIGHUP, $newaction, $oldaction); 105print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n"; 106 107eval { 108 sigaction(SIGHUP, undef, $oldaction); 109}; 110print $@ ? "not ok 15\n" : "ok 15\n"; 111 112eval { 113 sigaction(SIGHUP, 0, $oldaction); 114}; 115print $@ ? "not ok 16\n" : "ok 16\n"; 116 117eval { 118 sigaction(SIGHUP, bless({},'Class'), $oldaction); 119}; 120print $@ ? "ok 17\n" : "not ok 17\n"; 121 122if ($^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; 165sigaction(SIGHUP, undef, $oldaction); 166print $oldaction->safe ? "ok 22\n" : "not ok 22\n"; 167 168# SigAction handling is not safe ... 169sigaction(SIGHUP, POSIX::SigAction->new(\&foo)); 170sigaction(SIGHUP, undef, $oldaction); 171print $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); 176sigaction(SIGHUP, $newaction); 177sigaction(SIGHUP, undef, $oldaction); 178print $oldaction->safe ? "ok 24\n" : "not ok 24\n"; 179 180# And safe signal delivery must work 181$ok = 0; 182kill 'HUP', $$; 183print $ok ? "ok 25\n" : "not ok 25\n"; 184