This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Part Integrate mainline
[perl5.git] / ext / POSIX / sigaction.t
1 #!./perl
2
3 BEGIN {
4         chdir 't' if -d 't';
5         unshift @INC, '../lib';
6 }
7
8 BEGIN{
9         # Don't do anything if POSIX is missing, or sigaction missing.
10         eval { use POSIX; };
11         if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare') {
12                 print "1..0\n";
13                 exit 0;
14         }
15 }
16
17 use strict;
18 use vars qw/$bad7 $ok10 $bad18 $ok/;
19
20 $^W=1;
21
22 print "1..18\n";
23
24 sub IGNORE {
25         $bad7=1;
26 }
27
28 sub DEFAULT {
29         $bad18=1;
30 }
31
32 sub foo {
33         $ok=1;
34 }
35
36 my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
37 my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
38
39 {
40         my $bad;
41         local($SIG{__WARN__})=sub { $bad=1; };
42         sigaction(SIGHUP, $newaction, $oldaction);
43         if($bad) { print "not ok 1\n" } else { print "ok 1\n"}
44 }
45
46 if($oldaction->{HANDLER} eq 'DEFAULT' ||
47    $oldaction->{HANDLER} eq 'IGNORE')
48   { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"}
49 print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n";
50
51 sigaction(SIGHUP, $newaction, $oldaction);
52 if($oldaction->{HANDLER} eq '::foo')
53   { print "ok 4\n" } else { print "not ok 4\n"}
54 if($oldaction->{MASK}->ismember(SIGUSR1))
55   { print "ok 5\n" } else { print "not ok 5\n"}
56 if($oldaction->{FLAGS}) {
57     if ($^O eq 'linux' || $^O eq 'unicos') {
58         print "ok 6 # Skip: sigaction() thinks different in $^O\n";
59     } else {
60         print "not ok 6\n";
61     }
62 } else {
63     print "ok 6\n";
64 }
65
66 $newaction=POSIX::SigAction->new('IGNORE');
67 sigaction(SIGHUP, $newaction);
68 kill 'HUP', $$;
69 print $bad7 ? "not ok 7\n" : "ok 7\n";
70
71 print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n";
72 sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
73 print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n";
74
75 $newaction=POSIX::SigAction->new(sub { $ok10=1; });
76 sigaction(SIGHUP, $newaction);
77 {
78         local($^W)=0;
79         kill 'HUP', $$;
80 }
81 print $ok10 ? "ok 10\n" : "not ok 10\n";
82
83 print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n";
84
85 sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
86 # Make sure the signal mask gets restored after sigaction croak()s.
87 eval {
88         my $act=POSIX::SigAction->new('::foo');
89         delete $act->{HANDLER};
90         sigaction(SIGINT, $act);
91 };
92 kill 'HUP', $$;
93 print $ok ? "ok 12\n" : "not ok 12\n";
94
95 undef $ok;
96 # Make sure the signal mask gets restored after sigaction returns early.
97 my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
98 kill 'HUP', $$;
99 print !$x && $ok ? "ok 13\n" : "not ok 13\n";
100
101 $SIG{HUP}=sub {};
102 sigaction(SIGHUP, $newaction, $oldaction);
103 print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n";
104
105 eval {
106         sigaction(SIGHUP, undef, $oldaction);
107 };
108 print $@ ? "not ok 15\n" : "ok 15\n";
109
110 eval {
111         sigaction(SIGHUP, 0, $oldaction);
112 };
113 print $@ ? "not ok 16\n" : "ok 16\n";
114
115 eval {
116         sigaction(SIGHUP, bless({},'Class'), $oldaction);
117 };
118 print $@ ? "ok 17\n" : "not ok 17\n";
119
120 if ($^O eq 'VMS') {
121     print "ok 18 # Skip: SIGCONT not trappable in $^O\n";
122 } else {
123     $newaction=POSIX::SigAction->new(sub { $ok10=1; });
124     if (eval { SIGCONT; 1 }) {
125         sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
126         {
127             local($^W)=0;
128             kill 'CONT', $$;
129         }
130     }
131     print $bad18 ? "not ok 18\n" : "ok 18\n";
132 }
133