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