Permalink
Browse files

allow forking in the client

  • Loading branch information...
1 parent 7b51425 commit 53dc69adbf40345327c6c9f0a1ada88410d53789 @lestrrat lestrrat committed Nov 12, 2010
Showing with 57 additions and 3 deletions.
  1. +5 −3 lib/Test/TCP.pm
  2. +52 −0 t/09_fork.t
View
@@ -117,12 +117,14 @@ sub wait_port {
Test::TCP::Guard;
sub new {
my ($class, %args) = @_;
- bless { %args }, $class;
+ bless { %args, _mypid => $$ }, $class;
}
sub DESTROY {
my ($self) = @_;
- local $@;
- $self->{code}->();
+ if ($self->{_mypid} == $$) {
+ local $@;
+ $self->{code}->();
+ }
}
}
View
@@ -0,0 +1,52 @@
+use strict;
+use Test::More tests => 6;
+use Test::TCP;
+use t::Server;
+
+test_tcp
+ client => sub {
+ my $port = shift;
+
+ my $pid = fork();
+ if (! ok defined $pid, "Successfully forked child $pid") {
+ return diag("Could not fork: $!");
+ }
+
+ if (! $pid) {
+ eval {
+ ok 1, "Successfully executed child $$";
+ };
+ my $e = $@;
+ if (! ok !$e, "child exited normally") {
+ diag( "Encountered an error $e" );
+ }
+ exit;
+ }
+
+ waitpid($pid, 0);
+
+ # after the child has exited, we need to make sure that
+ # the server hasn't gone away.
+ my $sock = IO::Socket::INET->new(
+ PeerPort => $port,
+ PeerAddr => '127.0.0.1',
+ Proto => 'tcp'
+ );
+ if (! ok $sock, "socket is connected") {
+ return diag("Cannot open client socket: $!");
+ }
+
+ print {$sock} "Hello server\n";
+ my $res = <$sock>;
+ is $res, "Hello server\n", "got expected reply";
+ },
+ server => sub {
+ my $port = shift;
+ t::Server->new($port)->run(sub {
+ note "new request";
+ my ($remote, $line, $sock) = @_;
+ print {$remote} $line;
+ });
+ }
+;
+

0 comments on commit 53dc69a

Please sign in to comment.