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