1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
}
BEGIN {
if ($^O eq 'riscos') {
skip_all("kill() not implemented on this platform");
}
}
use strict;
use Config;
plan tests => 9;
ok( kill(0, $$), 'kill(0, $pid) returns true if $pid exists' );
# It's not easy to come up with an individual PID that is known not to exist,
# so just check that at least some PIDs in a large range are reported not to
# exist.
my $count = 0;
my $total = 30_000;
for my $pid (1 .. $total) {
++$count if kill(0, $pid);
}
# It is highly unlikely that all of the above PIDs are genuinely in use,
# so $count should be less than $total.
ok( $count < $total, 'kill(0, $pid) returns false if $pid does not exist' );
# Verify that trying to kill a non-numeric PID is fatal
my @bad_pids = (
[ undef , 'undef' ],
[ '' , 'empty string' ],
[ 'abcd', 'alphabetic' ],
);
for my $case ( @bad_pids ) {
my ($pid, $name) = @$case;
eval { kill 0, $pid };
like( $@, qr/^Can't kill a non-numeric process ID/, "dies killing $name pid");
}
# Verify that killing a magic variable containing a number doesn't
# trigger the above
{
my $x = $$ . " ";
$x =~ /(\d+)/;
ok(eval { kill 0, $1 }, "can kill a number string in a magic variable");
}
# RT #121230: test process group kill on Win32
SKIP: {
skip 'custom process group kill() only on Win32', 3 if ($^O ne 'MSWin32');
# Create 2 child processes: an outer one created by kill0.t that runs
# the "op/kill0_child" script, and an inner one created by outer that
# just does 'sleep 5'. We then try to kill both of them as a single
# process group. If only the outer one is killed, the inner will stay
# around and eventually print "not ok 9999", presenting out of sequence
# TAP to harness. The outer child creates a temporary file when it is
# ready.
my $killfile = 'tmp-killchildstarted';
unlink($killfile);
die "can't unlink $killfile: $!" if -e $killfile;
eval q{END {unlink($killfile);}};
my $pid = system(1, $^X, 'op/kill0_child', $killfile);
die 'PID is 0' if !$pid;
while( ! -e $killfile) {
sleep 1; # a sleep 0 with $i++ would take ~160 iterations here
}
# (some ways to manually make this test fail:
# change '-KILL' to 'KILL';
# change $pid to a bogus number)
is(kill('-KILL', $pid), 1, 'process group kill, named signal');
# create a mapping of signal names to numbers
my ($i, %signo, @signame, $sig_name) = 0;
($sig_name = $Config{sig_name}) || die "No signals?";
foreach my $name (split(' ', $sig_name)) {
$signo{$name} = $i;
$signame[$i] = $name;
$i++;
}
ok(scalar keys %signo > 1 && exists $signo{KILL},
'$Config{sig_name} parsed correctly');
die "a child proc wasn't killed and did cleanup on its own" if ! -e $killfile;
unlink $killfile;
# Now repeat the test with a numeric kill sigbal
die "can't unlink" if -e $killfile;
# no need to create another END block: already done earlier
$pid = system(1, $^X, 'op/kill0_child', $killfile);
die 'PID is 0' if !$pid;
while( ! -e $killfile) {
sleep 1; # a sleep 0 with $i++ would take ~160 iterations here
}
is(kill(-$signo{KILL}, $pid), 1, 'process group kill, numeric signal');
}
|
