Permalink
Browse files

Fixed tests and some tweaks

        Fixed race condition in tests (forking and modifying %ENV)
        Make final kill(0, $pid) sweep before determining process
        is not yet dead
  • Loading branch information...
mnunberg committed Apr 12, 2012
1 parent fbedf9d commit 3de9c663002eeb524600d83d1f03783cf3138ef4
Showing with 31 additions and 12 deletions.
  1. +4 −0 Changes
  2. +16 −7 lib/Proc/Terminator.pm
  3. +11 −5 t/00-all.t
View
@@ -1,4 +1,8 @@
Revision history for Proc-Terminator
+0.02 April 11 2012
+ Fixed race condition in tests (forking and modifying %ENV)
+ Make final kill(0, $pid) sweep before determining process
+ is not yet dead
0.01 Date/time
First version, released on an unsuspecting world.
View
@@ -18,11 +18,13 @@ sub try_kill {
my ($self,$do_kill) = @_;
if (kill(0, $self->pid) == 0) {
- $DEBUG and warn "Kill with signal=0 returned 0";
- if ($! != ESRCH) {
- warn $!;
+ my $errno_save = $!;
+ $DEBUG and warn "Kill with signal=0 returned 0 (dead!)";
+ if ($errno_save != ESRCH) {
+ warn $errno_save;
return -1;
}
+ # else, == ESRCH
return 1;
}
@@ -31,12 +33,12 @@ sub try_kill {
return 0;
}
my $sig = shift @{$self->siglist};
- $DEBUG and warn "Using signal $sig";
if (!defined $sig) {
$DEBUG and warn "Cannot kill ${\$self->pid} because no signals remain";
return -1;
}
+ $DEBUG and warn "Using signal $sig for ${\$self->pid}";
if (kill($sig, $self->pid) == 1) {
return 0;
@@ -54,10 +56,10 @@ package Proc::Terminator;
use warnings;
use strict;
use Time::HiRes qw(time sleep);
-use POSIX qw(:signal_h);
+use POSIX qw(:signal_h :sys_wait_h :errno_h);
use base qw(Exporter);
-our $VERSION = 0.01;
+our $VERSION = 0.02;
our @DefaultSignalOrder = (
SIGINT,
@@ -114,10 +116,17 @@ sub proc_terminate {
sleep($sleep_interval);
}
+ while (my ($pid,$whatever) = each %procs) {
+ if (kill(0, $pid) == 0 && $! == ESRCH) {
+ delete $procs{$pid};
+ }
+ }
+
if (%procs) {
warn("Processes still remain");
return undef;
}
+
if (wantarray) {
return @badprocs;
} else {
@@ -237,4 +246,4 @@ L<Perl's kill | kill>
Copyright (C) 2012 M. Nunberg
You may use and distribute this software under the same terms and conditions
-as Perl itself.
+as Perl itself.
View
@@ -21,20 +21,26 @@ my $CHILD_DEAD = 0;
my $PID;
$SIG{CHLD} = sub {
- note("A child terminated");
waitpid($PID, WNOHANG);
+ diag sprintf(
+ "REAP %d. WIFSIGNALED: %d WTERMSIG: %d",
+ $PID, WIFSIGNALED($?), WTERMSIG($?));
$CHILD_DEAD = 1;
};
sub _forkproc {
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
$PID = fork();
die "Couldn't fork" unless $PID >= 0;
+ diag "SPAWN $PID" if $PID;
+
if ($PID==0) {
- $SIG{INT} = 'IGNORE';
- $SIG{QUIT} = 'IGNORE';
- alarm(10);
+
+ alarm(15);
while (1) {
POSIX::pause();
+ warn("Interrupted..");
}
die("We shouldn't get here!");
}
@@ -67,4 +73,4 @@ $DURATION = time() - $BEGIN_TIME;
ok($DURATION < 1, "Slept less than a second");
ok($ret, "Killed ok with SIGTERM");
-done_testing();
+done_testing();

0 comments on commit 3de9c66

Please sign in to comment.