t/op/kill0.t

   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;
  16 use Config;
  17
  18 plan tests => 9;
  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' );
  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
  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
  58 SKIP: {
  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 }