#!./perl BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; } BEGIN{ # Don't do anything if POSIX is missing, or sigaction missing. use Config; eval 'use POSIX'; if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) { print "1..0\n"; exit 0; } } use strict; use vars qw/$bad7 $ok10 $bad18 $ok/; $^W=1; print "1..25\n"; sub IGNORE { $bad7=1; } sub DEFAULT { $bad18=1; } sub foo { $ok=1; } my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0); my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0); { my $bad; local($SIG{__WARN__})=sub { $bad=1; }; sigaction(SIGHUP, $newaction, $oldaction); if($bad) { print "not ok 1\n" } else { print "ok 1\n"} } if($oldaction->{HANDLER} eq 'DEFAULT' || $oldaction->{HANDLER} eq 'IGNORE') { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"} print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n"; sigaction(SIGHUP, $newaction, $oldaction); if($oldaction->{HANDLER} eq '::foo') { print "ok 4\n" } else { print "not ok 4\n"} if($oldaction->{MASK}->ismember(SIGUSR1)) { print "ok 5\n" } else { print "not ok 5\n"} if($oldaction->{FLAGS}) { if ($^O eq 'linux' || $^O eq 'unicos') { print "ok 6 # Skip: sigaction() thinks different in $^O\n"; } else { print "not ok 6\n"; } } else { print "ok 6\n"; } $newaction=POSIX::SigAction->new('IGNORE'); sigaction(SIGHUP, $newaction); kill 'HUP', $$; print $bad7 ? "not ok 7\n" : "ok 7\n"; print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n"; sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT')); print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n"; $newaction=POSIX::SigAction->new(sub { $ok10=1; }); sigaction(SIGHUP, $newaction); { local($^W)=0; kill 'HUP', $$; } print $ok10 ? "ok 10\n" : "not ok 10\n"; print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n"; sigaction(SIGHUP, POSIX::SigAction->new('::foo')); # Make sure the signal mask gets restored after sigaction croak()s. eval { my $act=POSIX::SigAction->new('::foo'); delete $act->{HANDLER}; sigaction(SIGINT, $act); }; kill 'HUP', $$; print $ok ? "ok 12\n" : "not ok 12\n"; undef $ok; # Make sure the signal mask gets restored after sigaction returns early. my $x=defined sigaction(SIGKILL, $newaction, $oldaction); kill 'HUP', $$; print !$x && $ok ? "ok 13\n" : "not ok 13\n"; $SIG{HUP}=sub {}; sigaction(SIGHUP, $newaction, $oldaction); print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n"; eval { sigaction(SIGHUP, undef, $oldaction); }; print $@ ? "not ok 15\n" : "ok 15\n"; eval { sigaction(SIGHUP, 0, $oldaction); }; print $@ ? "not ok 16\n" : "ok 16\n"; eval { sigaction(SIGHUP, bless({},'Class'), $oldaction); }; print $@ ? "ok 17\n" : "not ok 17\n"; if ($^O eq 'VMS') { print "ok 18 # Skip: SIGCONT not trappable in $^O\n"; } else { $newaction=POSIX::SigAction->new(sub { $ok10=1; }); if (eval { SIGCONT; 1 }) { sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT')); { local($^W)=0; kill 'CONT', $$; } } print $bad18 ? "not ok 18\n" : "ok 18\n"; } { local $SIG{__WARN__} = sub { }; # Just suffer silently. my $hup20; my $hup21; sub hup20 { $hup20++ } sub hup21 { $hup21++ } sigaction("FOOBAR", $newaction); print "ok 19\n"; # no coredump, still alive $newaction = POSIX::SigAction->new("hup20"); sigaction("SIGHUP", $newaction); kill "HUP", $$; print $hup20 == 1 ? "ok 20\n" : "not ok 20\n"; $newaction = POSIX::SigAction->new("hup21"); sigaction("HUP", $newaction); kill "HUP", $$; print $hup21 == 1 ? "ok 21\n" : "not ok 21\n"; } # "safe" attribute. # for this one, use the accessor instead of the attribute # standard signal handling via %SIG is safe $SIG{HUP} = \&foo; $oldaction = POSIX::SigAction->new; sigaction(SIGHUP, undef, $oldaction); print $oldaction->safe ? "ok 22\n" : "not ok 22\n"; # SigAction handling is not safe ... sigaction(SIGHUP, POSIX::SigAction->new(\&foo)); sigaction(SIGHUP, undef, $oldaction); print $oldaction->safe ? "not ok 23\n" : "ok 23\n"; # ... unless we say so! $newaction = POSIX::SigAction->new(\&foo); $newaction->safe(1); sigaction(SIGHUP, $newaction); sigaction(SIGHUP, undef, $oldaction); print $oldaction->safe ? "ok 24\n" : "not ok 24\n"; # And safe signal delivery must work $ok = 0; kill 'HUP', $$; print $ok ? "ok 25\n" : "not ok 25\n";