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