Permalink
Browse files

RT #47892: added regression test for PoCo-Server-TCP from Michael Fow…

…ler.
  • Loading branch information...
1 parent ebc87ee commit 4d943735b48f05568b6ed3805631dfd7e79ccd40 @bingos bingos committed Jul 15, 2009
Showing with 242 additions and 0 deletions.
  1. +1 −0 MANIFEST
  2. +241 −0 t/90_regression/somni-poco-server-tcp.t
View
@@ -147,6 +147,7 @@ t/90_regression/rt19908-merlyn-stop.t
t/90_regression/rt23181-sigchld-rc.t
t/90_regression/rt39872-sigchld-stop.t
# TODO - Why does this segfault for others: t/90_regression/rt39872-sigchld.t
+t/90_regression/somni-poco-server-tcp.t
t/90_regression/steinert-passed-wheel.t
t/90_regression/steinert-signal-integrity.t
t/90_regression/suzman_windows.t
@@ -0,0 +1,241 @@
+use warnings;
+use strict;
+
+BEGIN {
+ my $error;
+ unless (-f 'run_network_tests') {
+ $error = "Network access (and permission) required to run this test";
+ }
+
+ if ($error) {
+ print "1..0 # Skip $error\n";
+ exit;
+ }
+}
+
+use POE;
+use POE::Component::Server::TCP;
+use POE::Component::Client::TCP;
+use Socket qw(sockaddr_in inet_ntoa);
+use List::Util qw(first);
+
+use Test::More tests => 43;
+
+
+{
+ my @state = run();
+
+ ok_state_top(\@state, 'server started');
+ ok_state_top(\@state, 'client started');
+ ok_state_top(\@state, 'client connected to server: ARRAY');
+ ok_state_top(\@state, 'client connected');
+ ok_state_top(\@state, 'client flushed');
+ ok_state_any(\@state, 'received from server: I will be serving you today!');
+ ok_state_any(\@state, 'received from client: I am your new client!');
+ ok_state_top(\@state, 'received from server: Go away.');
+ ok_state_top(\@state, 'client disconnected');
+ ok_state_empty(\@state);
+}
+{
+ my @state = run( Port => 0 );
+
+ ok_state_top(\@state, 'server started');
+ ok_state_top(\@state, 'client started');
+ ok_state_top(\@state, 'client connected to server: ARRAY');
+ ok_state_top(\@state, 'client connected');
+ ok_state_top(\@state, 'client flushed');
+ ok_state_any(\@state, 'received from server: I will be serving you today!');
+ ok_state_any(\@state, 'received from client: I am your new client!');
+ ok_state_top(\@state, 'received from server: Go away.');
+ ok_state_top(\@state, 'client disconnected');
+ ok_state_empty(\@state);
+}
+{
+ my @state = run(
+ ClientArgs => [ {} ],
+ ListenerArgs => [ [], {}, \"", '' ],
+ );
+
+ ok_state_top(\@state, 'server started: ARRAY HASH SCALAR none');
+ ok_state_top(\@state, 'client started');
+ ok_state_top(\@state, 'client connected to server: ARRAY');
+ ok_state_top(\@state, 'client connected');
+ ok_state_top(\@state, 'client flushed');
+ ok_state_any(\@state, 'received from server: I will be serving you today!');
+ ok_state_any(\@state, 'received from client: I am your new client!');
+ ok_state_top(\@state, 'received from server: Go away.');
+ ok_state_top(\@state, 'client disconnected');
+ ok_state_empty(\@state);
+}
+{
+ my @state = run(
+ InlineStates => { InlineStates_test => \&InlineStates_test },
+ ObjectStates => [
+ bless({}, 'ObjectStates_test') => { ObjectStates_test => 'test' }
+ ],
+ PackageStates => [
+ 'PackageStates_test' => { PackageStates_test => 'test' },
+ ],
+ );
+
+ ok_state_top(\@state, 'server started');
+ ok_state_top(\@state, 'client started');
+ ok_state_top(\@state, 'client connected to server: ARRAY');
+ ok_state_top(\@state, 'client connected');
+ ok_state_top(\@state, 'InlineStates test: from server_client_connected');
+ ok_state_top(\@state, 'ObjectStates test: from server_client_connected');
+ ok_state_top(\@state, 'PackageStates test: from server_client_connected');
+ ok_state_top(\@state, 'client flushed');
+ ok_state_any(\@state, 'received from server: I will be serving you today!');
+ ok_state_any(\@state, 'received from client: I am your new client!');
+ ok_state_top(\@state, 'received from server: Go away.');
+ ok_state_top(\@state, 'client disconnected');
+ ok_state_empty(\@state);
+}
+
+
+
+### TESTING SUBROUTINES ###
+
+sub ok_state_empty { ok((not @{ $_[0] }), 'state is empty') }
+
+sub ok_state_top {
+ my($state, $value) = @_;
+ is($state->[0], $value, $value);
+ shift @$state if $state->[0] eq $value;
+}
+
+
+
+
+sub ok_state_any {
+ my($state, $value) = @_;
+ foreach my $i (0 .. $#$state) {
+ if ($state->[$i] eq $value) {
+ is($state->[$i], $value, $value);
+ splice(@$state, $i, 1);
+ return;
+ }
+ }
+
+ fail($value);
+}
+
+
+
+
+### UTILITY SUBROUTINES ###
+
+sub run {
+ my %args = @_;
+
+ our @state;
+ local @state;
+
+ POE::Component::Server::TCP->new(
+ Alias => 'server',
+ Started => \&server_started,
+ ClientConnected => \&server_client_connected,
+ ClientDisconnected => \&server_client_disconnected,
+ ClientInput => \&server_client_input,
+
+ %args,
+ );
+
+ POE::Kernel->run();
+
+ return @state;
+}
+
+
+
+
+sub arginfo {
+ my @args = @_[ARG0 .. $#_];
+ return '' unless @args;
+ return ': ' . join(" ", map { ref or 'none' } @_[ARG0 .. $#_]);
+}
+
+
+
+
+### CALLBACK SUBROUTINES ###
+
+sub ObjectStates_test::test { state("ObjectStates test: $_[ARG0]") }
+sub PackageStates_test::test { state("PackageStates test: $_[ARG0]") }
+sub InlineStates_test { state("InlineStates test: $_[ARG0]") }
+
+sub server_started {
+ my($kernel, $heap) = @_[KERNEL,HEAP];
+ my($port, $address) = sockaddr_in($heap->{'listener'}->getsockname);
+
+ state('server started', arginfo(@_));
+
+ POE::Component::Client::TCP->new(
+ RemoteAddress => inet_ntoa($address),
+ RemotePort => $port,
+ Started => \&client_started,
+ Connected => \&client_connected,
+ ServerInput => \&client_input,
+ ServerFlushed => \&client_flushed,
+ );
+
+ $kernel->yield( 'InlineStates_test' => 'from server_started' );
+ $kernel->yield( 'ObjectStates_test' => 'from server_started' );
+ $kernel->yield( 'PackageStates_test' => 'from server_started' );
+}
+
+
+
+
+sub server_client_connected {
+ my($kernel, $heap) = @_[KERNEL,HEAP];
+
+ state('client connected to server', arginfo(@_));
+ $heap->{'client'}->put('I will be serving you today!');
+
+ $kernel->yield( 'InlineStates_test' => 'from server_client_connected' );
+ $kernel->yield( 'ObjectStates_test' => 'from server_client_connected' );
+ $kernel->yield( 'PackageStates_test' => 'from server_client_connected' );
+}
+
+
+
+
+sub client_connected {
+ state('client connected');
+ $_[HEAP]{'server'}->put('I am your new client!');
+}
+
+
+
+
+sub server_client_disconnected {
+ state('client disconnected');
+ $_[KERNEL]->post( server => 'shutdown' );
+}
+
+
+
+
+sub client_input {
+ my($msg) = $_[ARG0];
+ state("received from server: $msg");
+ $_[KERNEL]->yield('shutdown') if $msg eq 'Go away.';
+}
+
+
+
+
+sub server_client_input {
+ state("received from client: $_[ARG0]");
+ $_[HEAP]{'client'}->put('Go away.');
+}
+
+
+
+
+sub client_flushed { state('client flushed') }
+sub client_started { state('client started') }
+
+sub state { push our @state, join("", @_) }

0 comments on commit 4d94373

Please sign in to comment.