Skip to content
Browse files

Apply Hinrik's patch to catch die() and his test case for proper

shutdown if a child coderef process dies.
  • Loading branch information...
1 parent 2817b50 commit b25e3127f6f750a2ef61dffe4b06d6daf60a1a52 @rcaputo committed Jun 22, 2010
Showing with 69 additions and 6 deletions.
  1. +2 −1 MANIFEST
  2. +10 −5 lib/POE/Wheel/Run.pm
  3. +57 −0 t/90_regression/hinrik-wheel-run-die.t
View
3 MANIFEST
@@ -146,6 +146,7 @@ t/90_regression/bingos-followtail.t
t/90_regression/broeren-win32-nbio.t
t/90_regression/cfedde-filter-httpd.t
t/90_regression/ferrari-server-unix.t
+t/90_regression/hinrik-wheel-run-die.t
t/90_regression/kjeldahl-stop-start-polling.t
t/90_regression/kjeldahl-stop-start-sig-nopipe.t
t/90_regression/kjeldahl-stop-start-sig-pipe.t
@@ -156,10 +157,10 @@ t/90_regression/rt1648-tied-stderr.t
t/90_regression/rt19908-merlyn-stop.t
t/90_regression/rt23181-sigchld-rc.t
t/90_regression/rt47966-sigchld.t
+t/90_regression/rt56417-wheel-run.t
t/90_regression/somni-poco-server-tcp.t
t/90_regression/steinert-passed-wheel.t
t/90_regression/suzman_windows.t
t/90_regression/ton-stop-corruption.t
t/90_regression/whelan-dieprop.t
t/90_regression/whjackson-followtail.t
-t/90_regression/rt56417-wheel-run.t
View
15 lib/POE/Wheel/Run.pm
@@ -429,10 +429,16 @@ sub new {
# our _exit_child_any_way_we_can handler...
# Should we replace CORE::exit? CORE::die too? blahhhhhh
# We've documented that users should not do it, but who knows!
- # Also, exceptions would screw this up - should it be eval'd?
- $program->(@$prog_args);
+ eval { $program->(@$prog_args) };
- __PACKAGE__->_exit_child_any_way_we_can();
+ my $exitval;
+ if ($@) {
+ chomp $@;
+ warn "$@\n";
+ $exitval = -1;
+ }
+
+ __PACKAGE__->_exit_child_any_way_we_can( $exitval || 0 );
}
# Execute an external program. This gets weird.
@@ -1175,8 +1181,7 @@ sub _redirect_child_stdio_sanely {
sub _exit_child_any_way_we_can {
my $class = shift;
- my $exitval = shift;
- $exitval = 0 unless defined $exitval;
+ my $exitval = shift || 0;
# First make sure stdio are flushed.
close STDIN if defined fileno(STDIN); # Voodoo?
View
57 t/90_regression/hinrik-wheel-run-die.t
@@ -0,0 +1,57 @@
+#!/usr/bin/env perl
+# vim: ts=2 sw=2 filetype=perl expandtab
+
+use strict;
+use warnings;
+use Test::More;
+use POE qw(Wheel::Run);
+
+plan tests => 2;
+
+POE::Session->create(
+ package_states => [
+ (__PACKAGE__) => [ qw( _start _child timeout) ]
+ ],
+);
+
+POE::Kernel->run();
+exit;
+
+sub _start {
+ $_[KERNEL]->delay('timeout', 5);
+
+ POE::Session->create(
+ inline_states => {
+ _start => sub {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ $heap->{wheel} = POE::Wheel::Run->new(
+ Program => sub { die },
+ StderrEvent => 'dummy',
+ CloseEvent => 'closure',
+ );
+
+ $kernel->sig_child($heap->{wheel}->PID, 'closure');
+ },
+
+ closure => sub {
+ return unless ++$_[HEAP]{dead} == 2;
+ delete $_[HEAP]{wheel};
+ pass("POE::Wheel::Run closed");
+ },
+ },
+ );
+}
+
+sub _child {
+ my ($kernel, $heap, $reason) = @_[KERNEL, HEAP, ARG0];
+ return if $reason eq 'create';
+
+ $kernel->delay('timeout');
+ is($reason, 'lose', 'Subsession died');
+}
+
+sub timeout {
+ fail('Timed out');
+ $_[KERNEL]->signal($_[KERNEL], "DIE");
+}

0 comments on commit b25e312

Please sign in to comment.
Something went wrong with that request. Please try again.