#!/usr/bin/perl # vim: ts=2 sw=2 filetype=perl expandtab use warnings; use strict; sub POE::Kernel::CATCH_EXCEPTIONS () { 0 } sub POE::Kernel::USE_SIGCHLD () { 1 } sub POE::Kernel::USE_SIGNAL_PIPE () { 1 } sub POE::Kernel::ASSERT_DEFAULT () { 1 } sub POE::Kernel::TRACE_DEFAULT () { 0 } use POE; use POE::Wheel::Run; use Test::More; sub DEBUG () { 0 } my $child_process_limit = 3; my $seconds_children_sleep = 1; # Each child process: # child sent done # child flushed # child exited # Each spawn # All children exited # Whole program # Sane exit my $test_count = 3 * $child_process_limit + 1 + 1; plan tests => $test_count; SKIP: { skip("$^O handles fork/call poorly", $test_count) if ( $^O eq "MSWin32" and not $ENV{POE_DANTIC} ); diag "This test can take up to ", $seconds_children_sleep*10, " seconds"; Work->spawn( $child_process_limit, $seconds_children_sleep ); $poe_kernel->run; pass( "Sane exit" ); } ############################################################################ package Work; use strict; use warnings; use POE; use Test::More; BEGIN { *DEBUG = \&::DEBUG; } sub spawn { my( $package, $count, $sleep ) = @_; POE::Session->create( inline_states => { _start => sub { my ($heap) = @_[HEAP, ARG0..$#_]; $poe_kernel->sig(CHLD => 'sig_CHLD'); foreach my $n (1 .. $count) { DEBUG and diag "$$: Launch child $n"; my $w = POE::Wheel::Run->new( Program => \&spawn_child, ProgramArgs => [ $sleep ], StdoutEvent => 'chld_stdout', StderrEvent => 'chld_stderr', CloseEvent => 'chld_close' ); $heap->{PID2W}{$w->PID} = {ID => $w->ID, N => $n, flushed=>0}; $heap->{W}{$w->ID} = $w; } $heap->{TID} = $poe_kernel->delay_set(timeout => $sleep*10); }, chld_stdout => sub { my ($heap, $line, $wid) = @_[HEAP, ARG0, ARG1]; my $wheel = $heap->{W}{$wid}; die "Unknown wheel $wid" unless $wheel; $line =~ s/\s+//g; is( $line, 'DONE', "stdout from $wid" ); if( $line eq 'DONE' ) { my $data = $heap->{PID2W}{ $wheel->PID }; $data->{flushed} = 1; } }, chld_stderr => sub { my ($heap, $line, $wid) = @_[HEAP, ARG0, ARG1]; my $wheel = $heap->{W}{$wid}; die "Unknown wheel $wid" unless $wheel; if (DEBUG) { diag "CHILD " . $wheel->PID . " STDERR: $line"; } else { fail "stderr from $wid: $line"; } }, say_goodbye => sub { DEBUG and diag "$$: saying goodbye"; foreach my $wheel (values %{$_[HEAP]{W}}) { $wheel->put("die\n"); } DEBUG and diag "$$: said my goodbyes"; }, timeout => sub { fail "Timed out waiting for children to exit"; $poe_kernel->stop(); }, sig_CHLD => sub { my ($heap, $signal, $pid) = @_[HEAP, ARG0, ARG1]; DEBUG and diag "$$: CHLD $pid"; my $data = $heap->{PID2W}{$pid}; die "Unknown wheel PID=$pid" unless defined $data; close_on( 'CHLD', $heap, $data->{ID} ); }, chld_close => sub { my ($heap, $wid) = @_[HEAP, ARG0]; DEBUG and diag "$$: close $wid"; close_on( 'close', $heap, $wid ); }, _stop => sub { }, # Pacify ASSERT_DEFAULT. } ); } sub close_on { my( $why, $heap, $wid ) = @_; my $wheel = $heap->{W}{$wid}; die "Unknown wheel $wid" unless $wheel; my $data = $heap->{PID2W}{ $wheel->PID }; $data->{$why}++; return unless $data->{CHLD} and $data->{close}; is( $data->{flushed}, 1, "expected child flush" ); delete $heap->{PID2W}{$wheel->PID}; delete $heap->{W}{$data->{ID}}; pass("Child $data->{ID} exit detected."); unless (keys %{$heap->{W}}) { pass "all children have exited"; $poe_kernel->alarm_remove(delete $heap->{TID}); } } sub spawn_child { my( $sleep ) = @_; DEBUG and diag "$$: child sleep=$sleep"; POE::Kernel->stop; POE::Session->create( inline_states => { _start => sub { $_[KERNEL]->delay( done => $sleep ); }, _stop => sub { DEBUG and diag "$$: child _stop"; }, done => sub { DEBUG and diag "$$: child done"; print "DONE\n"; }, } ); POE::Kernel->run; }