X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8af710ebc7fee929ae47793d5a0cce5362af52db..a5f48505593c7e1ca478de383e24d5cc2541f3ca:/t/op/kill0.t

diff --git a/t/op/kill0.t b/t/op/kill0.t
index d3ef8f7..7f6e6ec 100644
--- a/t/op/kill0.t
+++ b/t/op/kill0.t
@@ -13,8 +13,9 @@ BEGIN {
 }
 
 use strict;
+use Config;
 
-plan tests => 6;
+plan tests => 9;
 
 ok( kill(0, $$), 'kill(0, $pid) returns true if $pid exists' );
 
@@ -50,3 +51,58 @@ for my $case ( @bad_pids ) {
   $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');
+}