| Subject: | POE::Wheel::Run ref count problems |
A session's ref count isn't maintained properly when using
POE::Wheel::Run. I suspect it is being decremented 1 time to many in
the Wheel's DESTROY.
I've tested this with multiple POE versions :
- 0.38
- 0.37
- 0.9500
Perl : 5.8.8, 5.8.6.
| Subject: | test-sub.t |
#!/usr/bin/perl -w
# $Id$
use strict;
sub POE::Kernel::TRACE_REFCNT () { 0 }
sub POE::Kernel::ASSERT_DATA () { 1 }
use POE;
use Data::Dumper;
use Test::More ( tests => 2 );
sub DEBUG () { 0 }
SKIP: {
eval 'use POE::API::Peek;';
skip "Must have POE::API::Peek installed", 2 if $@;
my $object = Tester->spawn( [qw(client)] );
diag( "This test takes about 20 seconds" );
$poe_kernel->run();
pass( "Everything exited" );
is( $object->{refcnt}, 0, "Session refcnt is zero to exit" );
# DEBUG and warn Dumper $object;
}
##########################################################################
package Tester;
use strict;
use POE;
use POE::Wheel::Run;
my( $NODE, $SERVER, $CLIENT );
BEGIN {
*DEBUG = \&main::DEBUG;
$CLIENT = sub {
use strict;
$|++;
print "I am PID=$$\n";
my $N=5;
my $server = shift @_;
while( $N-- ) {
sleep 1;
print "still here\n";
}
};
}
my $HAVE_DAEMON=0;
eval q{
use POE::Component::Daemon;
$HAVE_DAEMON=1;
};
sub spawn
{
my( $package, $todo ) = @_;
my $self = bless { STARTUP=>$todo }, $package;
$self->create_session;
return $self;
}
sub create_session
{
my( $self ) = @_;
POE::Session->create(
inline_states => {
client_stdout => sub { $self->client_stdout( @_[ARG0..$#_] ) },
client_stderr => sub { $self->client_stderr( @_[ARG0..$#_] ) },
client_close => sub { $self->client_close( @_[ARG0..$#_] ) },
error => sub { $self->error( @_[ARG0..$#_] ) },
shutdown => sub { $self->shutdown( @_[ARG0..$#_] ) },
_start => sub { $self->start( @_[ARG0..$#_] ) },
_stop => sub { $self->stop( @_[ARG0..$#_] ) },
do_next => sub { $self->do_next( @_[ARG0..$#_] ) },
CHLD => sub { $self->CHLD( @_[ARG0..$#_] ) },
USR2 => sub { Daemon->peek( 1 ) if $HAVE_DAEMON; },
}
);
}
###################################################
sub start
{
my( $self ) = @_;
if( $HAVE_DAEMON ) {
# ::diag( "$0 is $$" );
$poe_kernel->sig( USR2 => 'USR2' );
}
$poe_kernel->sig( CHLD => 'CHLD' );
$poe_kernel->yield( 'do_next' );
}
###################################################
sub stop
{
my( $self ) = @_;
my $api = POE::API::Peek->new();
$self->{refcnt} = $api->get_session_refcount;
DEBUG and warn "Tester: STOP\n";
}
###################################################
sub do_next
{
my( $self ) = @_;
my $next = shift @{ $self->{STARTUP} };
unless( $next ) {
DEBUG and warn "Tester: Startup completed\n";
return;
}
$self->can( $next )->( $self );
$poe_kernel->delay( 'do_next', 2 );
}
###################################################
# Spawn node-client, which will connect to ikc-node and wait for node-server
# Also spawn a second ikc-node, which connects to first and listens
sub client
{
my( $self ) = @_;
# die "No server PID???!" unless $self->{server_PID};
DEBUG and warn "Tester: Launching client $self->{server_PID}\n";
# $poe_kernel->refcount_increment( $poe_kernel->get_active_session->ID, "Wheel::Run bug" );
$self->{client_wheel} = POE::Wheel::Run->new(
Program => $CLIENT,
ProgramArgs => [ $self->{server_PID} ],
ErrorEvent => 'error',
CloseEvent => 'client_close',
StdoutEvent => 'client_stdout',
StderrEvent => 'client_stderr',
Conduit => 'socketpair'
);
$self->{ PIDs }{ $self->{client_wheel}->PID } = 1;
}
######################################################
sub error
{
my( $self, $syscall, $errno, $errstr, $id, $handle ) = @_;
return if $errno == 0;
warn "Error in wheel $id during $syscall: $errno ($errstr) handle=$handle\n";
}
######################################################
sub CHLD
{
my( $self, $signal, $PID, $status ) = @_;
unless( delete $self->{ PIDs }{ $PID } ) {
warn "CHLD for someone else: PID=$PID status=$status";
}
else {
DEBUG and warn "Tester: CHLD for $PID\n";
}
}
######################################################
sub node_stdout
{
my( $self, $input, $wid ) = @_;
DEBUG and
warn "NODE: $input\n";
if( $input =~ /PID=(\d+)/ ) {
$self->{node_PID} = $1;
$self->child_pid( $self->{node_PID} );
END { kill 15, $self->{node_PID} if $self->{node_PID} };
}
else {
push @{ $self->{node_output} }, $input;
}
}
sub node_stderr
{
my( $self, $input, $wid ) = @_;
# DEBUG and
warn "NODE err: $input\n";
push @{ $self->{node_error} }, $input;
}
sub node_close
{
my( $self, $wid ) = @_;
DEBUG and warn "NODE wheel: closed\n";
delete $self->{node_wheel};
$self->{node_close}++;
}
######################################################
sub node2_stdout
{
my( $self, $input, $wid ) = @_;
DEBUG and warn "NODE2: $input\n";
if( $input =~ /PID=(\d+)/ ) {
$self->{node2_PID} = $1;
$self->child_pid( $self->{node2_PID} );
END { kill 15, $self->{node2_PID} if $self->{node2_PID} };
}
else {
push @{ $self->{node2_output} }, $input;
}
}
sub node2_stderr
{
my( $self, $input, $wid ) = @_;
DEBUG and warn "NODE2 err: $input\n";
if( $input =~ /An address was in use/ ) {
$self->{node2_in_use}++;
}
else {
push @{ $self->{node2_error} }, $input;
}
}
sub node2_close
{
my( $self, $wid ) = @_;
DEBUG and warn "NODE2 wheel: closed\n";
delete $self->{node2_wheel};
$self->{node2_close}++;
}
######################################################
sub server_stdout
{
my( $self, $input, $wid ) = @_;
DEBUG and warn "SERVER: $input\n";
if( $input =~ /PID=(\d+)/ ) {
$self->{server_PID} = $1;
$self->child_pid( $self->{server_PID} );
END { kill 15, $self->{server_PID} if $self->{server_PID} };
}
elsif( $input =~ /^I am ([-.\w]+-[0-9a-f]+)/ ) {
$self->{server_ID} = $1;
}
elsif( $input =~ /^Remote kernel (?:alias )?([-:.\w]+) went HELLO!/ ) {
$self->{server_connect}{$1}++;
}
elsif( $input =~ m(^Connected poe://(Client\d+)/me/pulse) ) {
$self->{client_connect}{$1}++;
}
elsif( $input =~ /^(Running server|Sending time|Done|Server exited).../ ) {
$self->{$1}++;
}
elsif( $input =~ m(^poe://(Client\d+)/me/pulse -- ) ) {
$self->{client_pulse}{$1}++;
}
elsif( $input =~ /\S/ ) {
push @{ $self->{server_output} }, $input;
}
}
sub server_stderr
{
my( $self, $input, $wid ) = @_;
if( $input =~ /Not connected to proxy-node/ ) {
die "Race-condition in server! ($input)\n";
}
DEBUG and warn "SERVER err: $input\n";
push @{ $self->{server_error} }, $input;
}
sub server_close
{
my( $self, $wid ) = @_;
DEBUG and warn "SERVER wheel: close\n";
delete $self->{server_wheel};
$self->{server_close}++;
}
######################################################
sub client_stdout
{
my( $self, $input, $wid ) = @_;
DEBUG and warn "CLIENT: $input\n";
if( $input =~ /PID=(\d+)/ ) {
$self->{client_PID} = $1;
$self->child_pid( $self->{client_PID} );
END { kill 15, $self->{client_PID} if $self->{client_PID} };
}
elsif( $input =~ /^I am ([-.\w]+-[0-9a-f]+)/ ) {
$self->{client_ID} = $1;
}
elsif( $input =~ /^\* connection to ([-:.\w]+)/ ) {
$self->{client_connect}{$1}++;
}
elsif( $input =~ m(^\*\*\*\*\* Connected to (Pulse)) ) {
$self->{client_connect_Pulse}++;
}
elsif( $input =~ m(^\*\*\*\*\* Disconnected from (Pulse)) ) {
$self->{client_connect_Pulse}--;
}
elsif( $input =~ m(^HONK HONK) ) {
$self->{client_honk}++;
}
elsif( $input =~ /^(Running client|Creating sessions).../ ) {
$self->{$1}++;
}
elsif( $input =~ m(Subscribed to HASH.+ on ([-:.\w]+)) ) {
$self->{client_subscribe}{$1}++;
}
elsif( $input =~ m(\|+ Foreign time is (.+)) ) {
$self->{client_time} = $1;
}
elsif( $input =~ m([+|]+\* disconnection from Pulse) ) {
$self->{client_disconnect} = 'Pulse';
}
elsif( $input =~ /\S/ ) {
push @{ $self->{client_output} }, $input;
}
}
sub client_stderr
{
my( $self, $input, $wid ) = @_;
DEBUG and warn "CLIENT err: $input\n";
push @{ $self->{client_error} }, $input;
}
sub client_close
{
my( $self, $wid ) = @_;
DEBUG and warn "Tester: Client closed; All done";
die "NO node2_PID!!" unless $self->{node2_PID};
# POE now waits for all children to exit before exiting
kill 15, $self->{node2_PID} if $self->{node2_PID};
$self->{client_close}++;
DEBUG and warn "Tester: Client close: shutdown\n";
if( $HAVE_DAEMON ) {
::diag( "kill -USR2 $$ # to find out why this isn't exiting" );
}
delete $self->{client_wheel};
delete $self->{server_wheel};
delete $self->{node_wheel};
delete $self->{node2_wheel};
die "NO node_PID!!" unless $self->{node_PID};
# POE now waits for all children to exit before exiting
kill 15, $self->{node_PID} if $self->{node_PID};
}
sub child_pid
{
my( $self, $pid ) = @_;
return unless $pid;
return unless $poe_kernel->can( 'sig_child' );
$poe_kernel->sig_child( $pid );
}
1;
__END__