develooper Front page | perl.perl5.porters | Postings from February 2014

[perl #121230] process group kill on Win32 broken in 5.17.2, regression 5.18

Thread Previous | Thread Next
From:
bulk88 via RT
Date:
February 27, 2014 17:02
Subject:
[perl #121230] process group kill on Win32 broken in 5.17.2, regression 5.18
Message ID:
rt-4.0.18-13142-1393520569-232.121230-15-0@perl.org
On Thu Feb 27 03:01:28 2014, Hugmeir wrote:
> On Thu, Feb 27, 2014 at 10:07 AM, bulk88 via RT
> > New patch attached.
> >
> > --
> > bulk88 ~ bulk88 at hotmail.com
> >
> > ---
> > via perlbug:  queue: perl5 status: open
> > https://rt.perl.org/Ticket/Display.html?id=121230
> >
> > From dc146462729d13b3038d9a58ac6291bc2e09f77f Mon Sep 17 00:00:00
> > 2001
> > From: bulk88 <bulk88@hotmail.com>
> > Date: Thu, 27 Feb 2014 04:00:43 -0500
> > Subject: [PATCH] RT #121230, create tests for process group kill on
> > Win32
> >
> > ---
> > MANIFEST          |    3 ++-
> > pod/perldelta.pod |    9 +++++++--
> > t/op/kill0.t      |   41 ++++++++++++++++++++++++++++++++++++++++-
> > t/op/kill0_child  |    9 +++++++++
> > 4 files changed, 58 insertions(+), 4 deletions(-)
> > create mode 100644 t/op/kill0_child
> >
> > diff --git a/MANIFEST b/MANIFEST
> > index 9fcb518..e7ab59a 100644
> > --- a/MANIFEST
> > +++ b/MANIFEST
> > @@ -5238,7 +5238,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
> > diff --git a/pod/perldelta.pod b/pod/perldelta.pod
> > index ab26873..f298d47 100644
> > --- a/pod/perldelta.pod
> > +++ b/pod/perldelta.pod
> > @@ -319,11 +319,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.17.2. 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].
> >
> 
> Better to use 5.18.0 here -- the vast majority of users have no reason
> to
> care about dev releases.

Will revise. But I need a response to my comments about the next comment first.

> 
> 
> >
> > =back
> >
> > diff --git a/t/op/kill0.t b/t/op/kill0.t
> > index d3ef8f7..4012761 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,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
> > index 0000000..c3d5eb2
> > --- /dev/null
> > +++ b/t/op/kill0_child
> > @@ -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;
> >
> 
> ^ how thoroughly was this tested? <10 second waits tend to fail on VMs
> quite often.
> 

Ran it a couple dozen times repeatedly breaking it by giving bogus signals, + signals, and fake pids and made sure harness failed as a not ok fail or out of sequence fail. Originally kill0.t did a "sleep 1;" to wait for the outer and inner procs to start. You dont want to kill the outer before it starts the inner proc which is what I encountered if the kill was sent with no delay after the system(). I then realized this is begging for a race condition and subsequent test fail in a VM with rough host timeslicing. I then switched to using the disk file. Win32::Event isn't core http://search.cpan.org/~cjm/Win32-IPC-1.09/lib/Win32/Event.pm . So I can't use that as IPC. It also is XS.

Sleeping a very high number near infinity sounds like a bad idea to me and a way to hang a smoker if something goes wrong (and what will go wrong can't be predicted). I picked 5 secs because it seems like a good balance between waiting the kill0.t to get back its timeslice and do the kill, vs I/O blocking harness since kill0.t failed to kill the 2 child procs (future or manual breakage), and now harness is waiting 4 seconds until the 2 child procs close their stdio handles, and probably (assuming a lack of random kernel memory corruption and being a couple ms away from a panic/bsod) will write "not ok" to the tap stream. Also I picked 5 instead of 3 secs because of a possibility of future parallel testing on Win32.

-- 
bulk88 ~ bulk88 at hotmail.com

---
via perlbug:  queue: perl5 status: open
https://rt.perl.org/Ticket/Display.html?id=121230

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About