r64863 - in /branches/upstream/libtest-tcp-perl/current: Changes MANIFEST META.yml inc/Test/More.pm lib/Test/TCP.pm t/09_fork.t
carnil at users.alioth.debian.org
carnil at users.alioth.debian.org
Sat Nov 13 15:49:06 UTC 2010
Author: carnil
Date: Sat Nov 13 15:48:34 2010
New Revision: 64863
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=64863
Log:
[svn-upgrade] new version libtest-tcp-perl (1.07)
Added:
branches/upstream/libtest-tcp-perl/current/t/09_fork.t
Modified:
branches/upstream/libtest-tcp-perl/current/Changes
branches/upstream/libtest-tcp-perl/current/MANIFEST
branches/upstream/libtest-tcp-perl/current/META.yml
branches/upstream/libtest-tcp-perl/current/inc/Test/More.pm
branches/upstream/libtest-tcp-perl/current/lib/Test/TCP.pm
Modified: branches/upstream/libtest-tcp-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/Changes?rev=64863&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/Changes (original)
+++ branches/upstream/libtest-tcp-perl/current/Changes Sat Nov 13 15:48:34 2010
@@ -1,4 +1,8 @@
Revision history for Perl extension Test::TCP
+
+1.07
+
+ - allow forking in the client(lestrrat)
1.06
Modified: branches/upstream/libtest-tcp-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/MANIFEST?rev=64863&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/MANIFEST (original)
+++ branches/upstream/libtest-tcp-perl/current/MANIFEST Sat Nov 13 15:48:34 2010
@@ -25,6 +25,7 @@
t/06_nest.t
t/07_optional.t
t/08_exit.t
+t/09_fork.t
t/Server.pm
xt/01_podspell.t
xt/02_perlcritic.t
Modified: branches/upstream/libtest-tcp-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/META.yml?rev=64863&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/META.yml (original)
+++ branches/upstream/libtest-tcp-perl/current/META.yml Sat Nov 13 15:48:34 2010
@@ -24,4 +24,4 @@
perl: 5.8.0
resources:
license: http://dev.perl.org/licenses/
-version: 1.06
+version: 1.07
Modified: branches/upstream/libtest-tcp-perl/current/inc/Test/More.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/inc/Test/More.pm?rev=64863&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/inc/Test/More.pm (original)
+++ branches/upstream/libtest-tcp-perl/current/inc/Test/More.pm Sat Nov 13 15:48:34 2010
@@ -1,7 +1,7 @@
#line 1
package Test::More;
-use 5.008001;
+use 5.006;
use strict;
use warnings;
@@ -18,7 +18,7 @@
return warn @_, " at $file line $line\n";
}
-our $VERSION = '2.00_01';
+our $VERSION = '0.97_01';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
Modified: branches/upstream/libtest-tcp-perl/current/lib/Test/TCP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/lib/Test/TCP.pm?rev=64863&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/lib/Test/TCP.pm (original)
+++ branches/upstream/libtest-tcp-perl/current/lib/Test/TCP.pm Sat Nov 13 15:48:34 2010
@@ -2,7 +2,7 @@
use strict;
use warnings;
use 5.00800;
-our $VERSION = '1.06';
+our $VERSION = '1.07';
use base qw/Exporter/;
use IO::Socket::INET;
use Test::SharedFork 0.12;
@@ -117,12 +117,14 @@
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}->();
+ }
}
}
@@ -242,6 +244,8 @@
Tatsuhiko Miyagawa
+lestrrat
+
=head1 SEE ALSO
=head1 LICENSE
Added: branches/upstream/libtest-tcp-perl/current/t/09_fork.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/t/09_fork.t?rev=64863&op=file
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/t/09_fork.t (added)
+++ branches/upstream/libtest-tcp-perl/current/t/09_fork.t Sat Nov 13 15:48:34 2010
@@ -1,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;
+ });
+ }
+;
+
More information about the Pkg-perl-cvs-commits
mailing list