# vim: ts=2 sw=2 expandtab
# Yuval Kogman's test case for edge issues with rethrowing unhandled
# die() exceptions and re-calling run() after it's returned due to
# such exceptions.
use warnings;
use strict;
use Test::More;
if ($^O eq "MSWin32" and not $ENV{POE_DANTIC}) {
plan skip_all => "Perl on $^O is too fragile for this test - it crashes";
CORE::exit(0);
eval 'use Win32::Console';
if ($@) {
plan skip_all => "Win32::Console is required on $^O - try ActivePerl";
}
if (exists $INC{'Tk.pm'} and not $ENV{POE_DANTIC}) {
plan skip_all => "Perl crashes in this test with Tk on $^O";
}
if (exists $INC{'Event.pm'} and not $ENV{POE_DANTIC}) {
plan skip_all => "Perl crashes in this test with Event on $^O";
}
}
plan tests => 9;
sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE qw/Wheel::Run/;
foreach my $die_on_bad_exit ( 0, 1 ) {
foreach my $exit ( 0, 1, 0, 0 ) {
POE::Session->create(
inline_states => {
_start => sub {
POE::Session->create(
inline_states => {
stdout => sub { },
stdin => sub { },
_parent => sub { },
_start => sub {
my ( $kernel, $session, $heap ) = @_[KERNEL, SESSION, HEAP];
$kernel->sig( CHLD => "sigchld_handler" );
my $wheel = POE::Wheel::Run->new(
Program => $heap->{program},
StdinEvent => "stdin",
StdoutEvent => "stdout",
);
$heap->{pid_to_wheel}->{ $wheel->PID } = $wheel;
$heap->{id_to_wheel}->{ $wheel->ID } = $wheel;
$kernel->refcount_increment(
$session->ID, "running_processes"
);
},
sigchld_handler => sub {
my ( $kernel, $session, $heap, $pid, $child_error ) = @_[
KERNEL, SESSION, HEAP, ARG1, ARG2
];
return unless exists $heap->{pid_to_wheel}{$pid};
$kernel->refcount_decrement(
$session->ID, "running_processes"
);
my $wheel = delete $heap->{pid_to_wheel}{$pid};
delete $heap->{id_to_wheel}{ $wheel->ID };
$kernel->sig( CHLD => undef );
$heap->{program_exit} = $child_error;
},
_stop => sub {
my ( $heap ) = $_[HEAP];
if ( scalar keys %{ $heap->{pid_to_wheel} } ) {
die "AAAAAAAHHH Running process leak!";
}
die "bad exit\n" if $die_on_bad_exit and (
$heap->{program_exit} >> 8
) != 0;
}
},
heap => { program => [ $^X, "-wle", "exit $exit" ] },
);
},
_stop => sub { },
_child => sub { },
_parent => sub { },
},
);
eval { POE::Kernel->run };
if ( $die_on_bad_exit and $exit ) {
ok( $@, "($die_on_bad_exit-$exit) died with bad exit code" );
is( $@, "bad exit\n", "($die_on_bad_exit-$exit) error is correct" );
}
else {
ok(
!$@, "($die_on_bad_exit-$exit) no error when process exited OK"
) or diag($@);
}
}
}
1;