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