#!/usr/bin/perl
use strict;
use warnings FATAL => "all";
no warnings "numeric";
use POE qw( Component::Pool::Thread );
use Test::Simple tests => 1;
# This test is full of screwed up race condition based behavior...it needs to
# be rethought.
#
# It appears the component is working correctly, I just apparently didn't know
# what I was doing at the time.
ok 1;
exit 0;
POE::Component::Pool::Thread->new
( MaxFree => 5,
MinFree => 2,
MaxThreads => 8,
StartThreads => 3,
Name => "ThreadPool",
EntryPoint => \&thread_entry_point,
CallBack => \&response,
inline_states => {
_start => sub {
$_[KERNEL]->yield("go");
},
go => sub {
my ($kernel, $session, $heap) = @_[ KERNEL, SESSION, HEAP ];
my ($thread, @free);
$kernel->call($session, run => 1) for 1 .. 3;
$thread = $heap->{thread};
@free = grep ${ $_->{semaphore} }, values %$thread;
# These are race condition-y
# ok(scalar keys %$thread == 0);
$kernel->call($session, run => 0) for 4 .. 20;
# ok @{ $heap->{queue} };
# What was I thinking...what an obvious race condition.
# $kernel->yield(run => "finished");
},
}
);
sub thread_entry_point {
my ($delay) = @_;
# So we can check
select undef, undef, undef, 0.5 if int $delay;
ok 1;
return $delay;
}
{
my $responses = 0;
sub response {
my ($kernel, $heap, $result) = @_[ KERNEL, HEAP, ARG0 ];
my (@thread, @free);
@thread = values %{ $heap->{thread} };
@free = grep ${ $_->{semaphore} }, @thread;
ok @thread <= 8;
if (@{ $heap->{queue} }) {
ok ((@free >= 2 && @free <= 5) || (@free == 8 && @thread <= 8));
}
else {
# During shut down or quick load drops this happens, but only
# temporarily. Eventually the component gets around to GC'ing
# everything. This is just to make sure there aren't extra threads
ok @free <= 8;
}
if (++$responses == 20) {
ok 1;
$kernel->yield("shutdown");
}
}
}
run POE::Kernel;