RT #121230, tests for process group kill on Win32
authorDaniel Dragan <bulk88@hotmail.com>
Mon, 17 Mar 2014 15:29:52 +0000 (15:29 +0000)
committerDavid Mitchell <davem@iabyn.com>
Mon, 17 Mar 2014 15:29:52 +0000 (15:29 +0000)
Add tests for 111f73b5d79, the fix for kill -SIG on win32, which was
broken in 5.18.0

(A follow-up commit will clean this code up a bit)

MANIFEST
pod/perldelta.pod
t/op/kill0.t
t/op/kill0_child [new file with mode: 0644]

index 331606c..a6708e4 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5240,7 +5240,8 @@ t/op/index.t                      See if index works
 t/op/index_thr.t               See if index works in another thread
 t/op/int.t                     See if int works
 t/op/join.t                    See if join works
-t/op/kill0.t                   See if kill(0, $pid) works
+t/op/kill0_child               Process tree script that is kill()ed
+t/op/kill0.t                   See if kill works
 t/op/kvaslice.t                        See if index/value array slices work
 t/op/kvhslice.t                        See if key/value hash slices work
 t/op/lc.t                      See if lc, uc, lcfirst, ucfirst, quotemeta work
index 08c234c..ba59a42 100644 (file)
@@ -390,11 +390,16 @@ and compilation changes or changes in portability/compatibility.  However,
 changes within modules for platforms should generally be listed in the
 L</Modules and Pragmata> section.
 
+=head3 Win32
+
 =over 4
 
-=item XXX-some-platform
+=item *
 
-XXX
+Killing a process tree with L<perlfunc/kill> and a negative signal, was broken
+starting in 5.18.0. In this bug, C<kill> always returned 0 for a negative
+signal even for valid PIDs, and no processes were terminated. This has been
+fixed [perl #121230].
 
 =back
 
index d3ef8f7..4012761 100644 (file)
@@ -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,41 @@ for my $case ( @bad_pids ) {
   $x =~ /(\d+)/;
   ok(eval { kill 0, $1 }, "can kill a number string in a magic variable");
 }
+
+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, and an inner one
+  #created by outer this allows the test to fail if only the outer one was
+  #killed, since the inner will stay around and eventually print failed and
+  #out of sequence TAP to harness
+  unlink('killchildstarted');
+  die q|can't unlink| if -e 'killchildstarted';
+  eval q|END{unlink('killchildstarted');}|;
+  my $pid = system(1, $^X, 'op/kill0_child', 'killchildstarted');
+  die 'PID is 0' if !$pid;
+  while( ! -e 'killchildstarted') {
+    sleep 1; #a sleep 0 with $i++ will takes ~160 iterations here
+  }
+  #ways to break this test manually, change '-KILL' to 'KILL', change $pid to a
+  #bogus number
+  is(kill('-KILL', $pid), 1, 'process group kill, named signal');
+
+  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 q|A child proc wasn't killed and did cleanup on its own| if ! -e 'killchildstarted';
+  unlink('killchildstarted');
+  die q|can't unlink| if -e 'killchildstarted';
+  #no END block, done earlier
+  $pid = system(1, $^X, 'op/kill0_child', 'killchildstarted');
+  die 'PID is 0' if !$pid;
+  while( ! -e 'killchildstarted') {
+    sleep 1; #a sleep 0 with $i++ will takes ~160 iterations here
+  }
+  is(kill(-$signo{KILL}, $pid), 1, 'process group kill, numeric signal');
+}
diff --git a/t/op/kill0_child b/t/op/kill0_child
new file mode 100644 (file)
index 0000000..2577416
--- /dev/null
@@ -0,0 +1,9 @@
+#$ARGV[0] is filename used to notify parent .t perl proc that all PIDs are
+#started in the process tree
+#number 9999/9998 is eye catching
+system(1, $^X, '-e', 'sleep 5; print qq|not ok 9999 - inner child process wasn\'t killed\n|;');
+system('echo outer child started > "'.$ARGV[0].'"');
+sleep 5;
+#execution won't be reached if test successful
+print "not ok 9998 - outer child process wasn\'t killed\n";
+unlink($ARGV[0]);