POSIX/t/sigaction.t

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