Commit | Line | Data |
---|---|---|
b84cdbe2 SH |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
9 | BEGIN { | |
10 | if ($^O eq 'riscos') { | |
11 | skip_all("kill() not implemented on this platform"); | |
12 | } | |
13 | } | |
14 | ||
15 | use strict; | |
af728ca1 | 16 | use Config; |
b84cdbe2 | 17 | |
af728ca1 | 18 | plan tests => 9; |
b84cdbe2 SH |
19 | |
20 | ok( 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. | |
25 | my $count = 0; | |
26 | my $total = 30_000; | |
27 | for 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. | |
32 | ok( $count < $total, 'kill(0, $pid) returns false if $pid does not exist' ); | |
e2c0f81f DG |
33 | |
34 | # Verify that trying to kill a non-numeric PID is fatal | |
35 | my @bad_pids = ( | |
36 | [ undef , 'undef' ], | |
37 | [ '' , 'empty string' ], | |
38 | [ 'abcd', 'alphabetic' ], | |
39 | ); | |
40 | ||
41 | for 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 | ||
8af710eb TC |
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 | } | |
af728ca1 | 54 | |
4c0e595c DM |
55 | |
56 | # RT #121230: test process group kill on Win32 | |
57 | ||
af728ca1 DD |
58 | SKIP: { |
59 | skip 'custom process group kill() only on Win32', 3 if ($^O ne 'MSWin32'); | |
4c0e595c DM |
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); | |
af728ca1 | 75 | die 'PID is 0' if !$pid; |
4c0e595c DM |
76 | while( ! -e $killfile) { |
77 | sleep 1; # a sleep 0 with $i++ would take ~160 iterations here | |
af728ca1 | 78 | } |
4c0e595c DM |
79 | # (some ways to manually make this test fail: |
80 | # change '-KILL' to 'KILL'; | |
81 | # change $pid to a bogus number) | |
af728ca1 DD |
82 | is(kill('-KILL', $pid), 1, 'process group kill, named signal'); |
83 | ||
4c0e595c DM |
84 | # create a mapping of signal names to numbers |
85 | ||
af728ca1 DD |
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 | } | |
4c0e595c DM |
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); | |
af728ca1 | 103 | die 'PID is 0' if !$pid; |
4c0e595c DM |
104 | while( ! -e $killfile) { |
105 | sleep 1; # a sleep 0 with $i++ would take ~160 iterations here | |
af728ca1 DD |
106 | } |
107 | is(kill(-$signo{KILL}, $pid), 1, 'process group kill, numeric signal'); | |
108 | } |