Subject: | Win32 perl crash using POE::Wheel::Run::Win32 |
This POE test case makes Perl (both ActivePerl 1003 and Strawberry Perl
5.10.0 (Jan 2009)) crash.
Don't know who is at fault. POE ? Win32::Job ? Perl ?
--
Olivier Mengué - http://o.mengue.free.fr/
Subject: | 18-multi-probe.t |
use warnings;
use strict;
{
# This class runs a command and capture the first output line
# and the result code.
package Running;
use POE qw(Wheel::Run::Win32);
sub run
{
my ($class, %args) = @_;
my $self = bless {
# Args
Command => $args{Command},
TimeOut => $args{TimeOut},
StartEvent => $args{StartEvent},
EndEvent => $args{EndEvent},
# Result
ResultCode => undef,
StdOut => undef,
StdErr => undef,
}, $class;
POE::Session->create(
heap => $self,
inline_states => {
_start => \&_event_Start,
#_stop => sub { print "# Stop SupAgent::Probe::Running" },
StdOut => \&_event_StdOut,
StdErr => \&_event_StdErr,
TimeOut => \&_event_TimeOut,
SigChld => \&_event_SigChld,
},
);
return $self;
}
sub id { $_[0]->{Id} }
sub result
{
my $self = shift;
($self->{ResultCode}, (defined $self->{StdOut} ? $self->{StdOut} : $self->{StdErr}))
}
sub _event_Start
{
my $self = $_[HEAP];
# The session from which we were created is the one that will
# receive the events
$self->{Session} = $_[SENDER];
$self->{Id} = $_[SESSION]->ID;
my $child = $self->{Child} = eval { POE::Wheel::Run::Win32->new(
Program => $self->{Command},
StdoutEvent => 'StdOut',
StderrEvent => 'StdErr',
ErrorEvent => 'Error',
#CloseEvent => 'AllClosed',
StdoutFilter => POE::Filter::Line->new,
StderrFilter => POE::Filter::Line->new,
#NoSetSid => 1,
) };
unless ($@) {
my $pid = $child->PID;
$poe_kernel->post($self->{Session}, $self->{StartEvent}, $self);
$self->{TimeoutId} = $poe_kernel->delay_set(TimeOut => $self->{TimeOut});
$poe_kernel->sig_child($pid, 'SigChld');
return $pid;
} else {
warn "# $@";
return undef;
}
}
sub _event_StdOut
{
return if defined $_[HEAP]->{StdOut};
$_[HEAP]->{StdOut} = $_[ARG0];
}
sub _event_StdErr
{
return if defined $_[HEAP]->{StdErr};
$_[HEAP]->{StdErr} = $_[ARG0];
}
sub _event_TimeOut
{
warn "# Timeout";
delete $_[HEAP]->{TimeoutId};
$_[HEAP]->{Child}->kill(9);
}
sub _event_SigChld
{
my $self = $_[HEAP];
if (exists $self->{TimeoutId}) {
$self->{ResultCode} = $_[ARG2] >> 8 unless defined $self->{ResultCode};
$poe_kernel->alarm_remove(delete $self->{TimeoutId});
} else {
$self->{StdOut} = undef;
$self->{StdErr} = undef;
}
# Release the wheel
delete $self->{Child};
# Release the reference to $self stored in the session
$_[HEAP] = undef;
$poe_kernel->post($self->{Session}, $self->{EndEvent}, $self);
# Release the session
delete $self->{Session};
}
}
package main;
use Test::More;
use POE;
my @probes = ([
'probe-ok',
'cmd /C echo OK - No problem',
10
], [
'probe-err',
'cmd /C echo CRITICAL >&2 & exit 2',
10
]);
my $start_event_fired = 0;
my $end_event_fired = 0;
sub launch_process
{
POE::Session->create(
inline_states => {
_start => sub {
pass("_start ".$_[SESSION]->ID);
$_[HEAP] = {};
for my $probe (@probes) {
# Start the probe
local $@;
my $r = Running->run(
Command => $probe->[1],
TimeOut => $probe->[2],
StartEvent => 'probe_start',
EndEvent => 'probe_end',
);
$_[HEAP]->{$r->id} = $r;
}
},
_stop => sub {
pass("_stop ".$_[SESSION]->ID);
},
probe_start => sub {
pass("StartEvent fired ".$_[ARG0]->id);
$start_event_fired++;
},
probe_end => sub {
pass("EndEvent fired ".$_[ARG0]->id);
$end_event_fired++;
my $running = $_[ARG0];
my ($code, $data) = $running->result;
# Release the object
delete $_[HEAP]->{$running->id};
}
}
);
}
my $launch_count = 1;
plan tests => 4+$launch_count*(1+6*@probes);
diag "$^X";
POE::Session->create(
inline_states => {
_start => sub {
pass("_start ".$_[SESSION]->ID);
$poe_kernel->yield('launch') for 1..$launch_count;
},
launch => sub {
pass('launch');
launch_process();
},
_child => sub {
pass("_child $_[ARG0] ".$_[ARG1]->ID);
},
_stop => sub {
pass("_stop ".$_[SESSION]->ID);
},
}
);
POE::Kernel->run();
is($start_event_fired, $launch_count*@probes, "StartEvent fired $launch_count times");
is($end_event_fired, $launch_count*@probes, "EndEvent fired $launch_count times");