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 Test::More tests => 31; 20 21use strict; 22use vars qw/$bad $bad7 $ok10 $bad18 $ok/; 23 24$^W=1; 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 ok(!$bad, "no warnings"); 46} 47 48ok($oldaction->{HANDLER} eq 'DEFAULT' || 49 $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER}); 50 51is($SIG{HUP}, '::foo'); 52 53sigaction(SIGHUP, $newaction, $oldaction); 54is($oldaction->{HANDLER}, '::foo'); 55 56ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK"); 57 58SKIP: { 59 skip("sigaction() thinks different in $^O", 1) 60 if $^O eq 'linux' || $^O eq 'unicos'; 61 is($oldaction->{FLAGS}, 0); 62} 63 64$newaction=POSIX::SigAction->new('IGNORE'); 65sigaction(SIGHUP, $newaction); 66kill 'HUP', $$; 67ok(!$bad, "SIGHUP ignored"); 68 69is($SIG{HUP}, 'IGNORE'); 70sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT')); 71is($SIG{HUP}, 'DEFAULT'); 72 73$newaction=POSIX::SigAction->new(sub { $ok10=1; }); 74sigaction(SIGHUP, $newaction); 75{ 76 local($^W)=0; 77 kill 'HUP', $$; 78} 79ok($ok10, "SIGHUP handler called"); 80 81is(ref($SIG{HUP}), 'CODE'); 82 83sigaction(SIGHUP, POSIX::SigAction->new('::foo')); 84# Make sure the signal mask gets restored after sigaction croak()s. 85eval { 86 my $act=POSIX::SigAction->new('::foo'); 87 delete $act->{HANDLER}; 88 sigaction(SIGINT, $act); 89}; 90kill 'HUP', $$; 91ok($ok, "signal mask gets restored after croak"); 92 93undef $ok; 94# Make sure the signal mask gets restored after sigaction returns early. 95my $x=defined sigaction(SIGKILL, $newaction, $oldaction); 96kill 'HUP', $$; 97ok(!$x && $ok, "signal mask gets restored after early return"); 98 99$SIG{HUP}=sub {}; 100sigaction(SIGHUP, $newaction, $oldaction); 101is(ref($oldaction->{HANDLER}), 'CODE'); 102 103eval { 104 sigaction(SIGHUP, undef, $oldaction); 105}; 106ok(!$@, "undef for new action"); 107 108eval { 109 sigaction(SIGHUP, 0, $oldaction); 110}; 111ok(!$@, "zero for new action"); 112 113eval { 114 sigaction(SIGHUP, bless({},'Class'), $oldaction); 115}; 116ok($@, "any object not good as new action"); 117 118SKIP: { 119 skip("SIGCONT not trappable in $^O", 1) 120 if ($^O eq 'VMS'); 121 $newaction=POSIX::SigAction->new(sub { $ok10=1; }); 122 if (eval { SIGCONT; 1 }) { 123 sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT')); 124 { 125 local($^W)=0; 126 kill 'CONT', $$; 127 } 128 } 129 ok(!$bad18, "SIGCONT trappable"); 130} 131 132{ 133 local $SIG{__WARN__} = sub { }; # Just suffer silently. 134 135 my $hup20; 136 my $hup21; 137 138 sub hup20 { $hup20++ } 139 sub hup21 { $hup21++ } 140 141 sigaction("FOOBAR", $newaction); 142 ok(1, "no coredump, still alive"); 143 144 $newaction = POSIX::SigAction->new("hup20"); 145 sigaction("SIGHUP", $newaction); 146 kill "HUP", $$; 147 is($hup20, 1); 148 149 $newaction = POSIX::SigAction->new("hup21"); 150 sigaction("HUP", $newaction); 151 kill "HUP", $$; 152 is ($hup21, 1); 153} 154 155# "safe" attribute. 156# for this one, use the accessor instead of the attribute 157 158# standard signal handling via %SIG is safe 159$SIG{HUP} = \&foo; 160$oldaction = POSIX::SigAction->new; 161sigaction(SIGHUP, undef, $oldaction); 162ok($oldaction->safe, "SIGHUP is safe"); 163 164# SigAction handling is not safe ... 165sigaction(SIGHUP, POSIX::SigAction->new(\&foo)); 166sigaction(SIGHUP, undef, $oldaction); 167ok(!$oldaction->safe, "SigAction not safe by default"); 168 169# ... unless we say so! 170$newaction = POSIX::SigAction->new(\&foo); 171$newaction->safe(1); 172sigaction(SIGHUP, $newaction); 173sigaction(SIGHUP, undef, $oldaction); 174ok($oldaction->safe, "SigAction can be safe"); 175 176# And safe signal delivery must work 177$ok = 0; 178kill 'HUP', $$; 179ok($ok, "safe signal delivery must work"); 180 181SKIP: { 182 eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX); scalar %SIGRT + SIGRTMIN() + SIGRTMAX()'; 183 $@ # POSIX did not exort 184 || SIGRTMIN() < 0 || SIGRTMAX() < 0 # HP-UX 10.20 exports both as -1 185 || SIGRTMIN() > $Config{sig_count} # AIX 4.3.3 exports bogus 888 and 999 186 and skip("no SIGRT signals", 4); 187 ok(SIGRTMAX() > SIGRTMIN(), "SIGRTMAX > SIGRTMIN"); 188 is(scalar %SIGRT, SIGRTMAX() - SIGRTMIN() + 1, "scalar SIGRT"); 189 my $sigrtmin; 190 my $h = sub { $sigrtmin = 1 }; 191 $SIGRT{SIGRTMIN} = $h; 192 is($SIGRT{SIGRTMIN}, $h, "handler set & get"); 193 kill 'SIGRTMIN', $$; 194 is($sigrtmin, 1, "SIGRTMIN handler works"); 195} 196 197SKIP: { 198 eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO'; 199 skip("no SA_SIGINFO", 1) if $@; 200 sub hiphup { 201 is($_[1]->{signo}, SIGHUP, "SA_SIGINFO got right signal"); 202 } 203 my $act = POSIX::SigAction->new('hiphup', 0, SA_SIGINFO); 204 sigaction(SIGHUP, $act); 205 kill 'HUP', $$; 206} 207 208eval { sigaction(-999, "foo"); }; 209like($@, qr/Negative signals/, 210 "Prevent negative signals instead of core dumping"); 211