r70358 - in /branches/upstream/libtest-tcp-perl/current: Changes META.yml Makefile.PL inc/Test/More.pm lib/Test/TCP.pm t/00_compile.t t/03_return_when_sigterm.t t/04_die.t t/06_nest.t t/09_fork.t t/10_oo.t
carnil at users.alioth.debian.org
carnil at users.alioth.debian.org
Fri Mar 4 19:16:55 UTC 2011
Author: carnil
Date: Fri Mar 4 19:11:11 2011
New Revision: 70358
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70358
Log:
[svn-upgrade] new version libtest-tcp-perl (1.12)
Modified:
branches/upstream/libtest-tcp-perl/current/Changes
branches/upstream/libtest-tcp-perl/current/META.yml
branches/upstream/libtest-tcp-perl/current/Makefile.PL
branches/upstream/libtest-tcp-perl/current/inc/Test/More.pm
branches/upstream/libtest-tcp-perl/current/lib/Test/TCP.pm
branches/upstream/libtest-tcp-perl/current/t/00_compile.t
branches/upstream/libtest-tcp-perl/current/t/03_return_when_sigterm.t
branches/upstream/libtest-tcp-perl/current/t/04_die.t
branches/upstream/libtest-tcp-perl/current/t/06_nest.t
branches/upstream/libtest-tcp-perl/current/t/09_fork.t
branches/upstream/libtest-tcp-perl/current/t/10_oo.t
Modified: branches/upstream/libtest-tcp-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/Changes?rev=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/Changes (original)
+++ branches/upstream/libtest-tcp-perl/current/Changes Fri Mar 4 19:11:11 2011
@@ -1,4 +1,10 @@
Revision history for Perl extension Test::TCP
+
+1.12
+
+ - workaround for win32 test fails.
+ https://rt.cpan.org/Ticket/Display.html?id=66016
+ - more diagnostic messages
1.11
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=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/META.yml (original)
+++ branches/upstream/libtest-tcp-perl/current/META.yml Fri Mar 4 19:11:11 2011
@@ -24,4 +24,4 @@
perl: 5.8.0
resources:
license: http://dev.perl.org/licenses/
-version: 1.11
+version: 1.12
Modified: branches/upstream/libtest-tcp-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/Makefile.PL?rev=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/Makefile.PL (original)
+++ branches/upstream/libtest-tcp-perl/current/Makefile.PL Fri Mar 4 19:11:11 2011
@@ -8,7 +8,7 @@
requires 'Test::SharedFork' => 0.14;
tests 't/*.t t/*/*.t t/*/*/*.t t/*/*/*/*.t';
-test_requires 'Test::More';
+test_requires 'Test::More' => 0.98;
author_tests 'xt';
auto_include;
WriteAll;
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=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/inc/Test/More.pm (original)
+++ branches/upstream/libtest-tcp-perl/current/inc/Test/More.pm Fri Mar 4 19:11:11 2011
@@ -18,7 +18,7 @@
return warn @_, " at $file line $line\n";
}
-our $VERSION = '0.97_01';
+our $VERSION = '0.98';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
@@ -88,7 +88,7 @@
return $tb->ok( $test, $name );
}
-#line 367
+#line 372
sub is ($$;$) {
my $tb = Test::More->builder;
@@ -104,7 +104,7 @@
*isn't = \&isnt;
-#line 411
+#line 416
sub like ($$;$) {
my $tb = Test::More->builder;
@@ -112,7 +112,7 @@
return $tb->like(@_);
}
-#line 426
+#line 431
sub unlike ($$;$) {
my $tb = Test::More->builder;
@@ -120,7 +120,7 @@
return $tb->unlike(@_);
}
-#line 471
+#line 476
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
@@ -128,7 +128,7 @@
return $tb->cmp_ok(@_);
}
-#line 506
+#line 511
sub can_ok ($@) {
my( $proto, @methods ) = @_;
@@ -162,7 +162,7 @@
return $ok;
}
-#line 572
+#line 577
sub isa_ok ($$;$) {
my( $object, $class, $obj_name ) = @_;
@@ -222,7 +222,7 @@
return $ok;
}
-#line 651
+#line 656
sub new_ok {
my $tb = Test::More->builder;
@@ -247,7 +247,7 @@
return $obj;
}
-#line 736
+#line 741
sub subtest {
my ($name, $subtests) = @_;
@@ -256,7 +256,7 @@
return $tb->subtest(@_);
}
-#line 760
+#line 765
sub pass (;$) {
my $tb = Test::More->builder;
@@ -270,7 +270,7 @@
return $tb->ok( 0, @_ );
}
-#line 828
+#line 833
sub use_ok ($;@) {
my( $module, @imports ) = @_;
@@ -332,7 +332,7 @@
return( $eval_result, $eval_error );
}
-#line 897
+#line 902
sub require_ok ($) {
my($module) = shift;
@@ -376,7 +376,7 @@
return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
}
-#line 974
+#line 979
our( @Data_Stack, %Refs_Seen );
my $DNE = bless [], 'Does::Not::Exist';
@@ -483,7 +483,7 @@
return '';
}
-#line 1134
+#line 1139
sub diag {
return Test::More->builder->diag(@_);
@@ -493,13 +493,13 @@
return Test::More->builder->note(@_);
}
-#line 1160
+#line 1165
sub explain {
return Test::More->builder->explain(@_);
}
-#line 1226
+#line 1231
## no critic (Subroutines::RequireFinalReturn)
sub skip {
@@ -527,7 +527,7 @@
last SKIP;
}
-#line 1310
+#line 1315
sub todo_skip {
my( $why, $how_many ) = @_;
@@ -548,7 +548,7 @@
last TODO;
}
-#line 1365
+#line 1370
sub BAIL_OUT {
my $reason = shift;
@@ -557,7 +557,7 @@
$tb->BAIL_OUT($reason);
}
-#line 1404
+#line 1409
#'#
sub eq_array {
@@ -697,7 +697,7 @@
}
}
-#line 1551
+#line 1556
sub eq_hash {
local @Data_Stack = ();
@@ -732,7 +732,7 @@
return $ok;
}
-#line 1610
+#line 1615
sub eq_set {
my( $a1, $a2 ) = @_;
@@ -757,6 +757,6 @@
);
}
-#line 1812
+#line 1817
1;
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=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/lib/Test/TCP.pm (original)
+++ branches/upstream/libtest-tcp-perl/current/lib/Test/TCP.pm Fri Mar 4 19:11:11 2011
@@ -2,7 +2,7 @@
use strict;
use warnings;
use 5.00800;
-our $VERSION = '1.11';
+our $VERSION = '1.12';
use base qw/Exporter/;
use IO::Socket::INET;
use Test::SharedFork 0.12;
@@ -108,12 +108,16 @@
my $self = shift;
if ( my $pid = fork() ) {
# parent.
+ $self->{pid} = $pid;
Test::TCP::wait_port($self->port);
- $self->{pid} = $pid;
return;
} elsif ($pid == 0) {
# child process
$self->{code}->($self->port);
+ # should not reach here
+ if (kill 0, $self->{_my_pid}) { # warn only parent process still exists
+ warn("[Test::TCP] Child process does not block(PID: $$, PPID: $self->{_my_pid})");
+ }
exit 0;
} else {
die "fork failed: $!";
@@ -163,6 +167,34 @@
=head1 SYNOPSIS
use Test::TCP;
+
+ my $server = Test::TCP->new(
+ code => sub {
+ my $port = shift;
+ ...
+ },
+ );
+ my $client = MyClient->new(host => '127.0.0.1', port => $server->port);
+ undef $server; # kill child process on DESTROY
+
+Using memcached:
+
+ use Test::TCP;
+
+ my $memcached = Test::TCP->new(
+ code => sub {
+ my $port = shift;
+
+ exec $bin, '-p' => $port;
+ die "cannot execute $bin: $!";
+ },
+ );
+ my $memd = Cache::Memcached->new({servers => ['127.0.0.1:' . $memcached->port]});
+ ...
+
+And functional interface is available:
+
+ use Test::TCP;
test_tcp(
client => sub {
my ($port, $server_pid) = @_;
@@ -174,35 +206,9 @@
},
);
-using other server program
-
- use Test::TCP;
- test_tcp(
- client => sub {
- my $port = shift;
- # send request to the server
- },
- server => sub {
- exec '/foo/bar/bin/server', 'options';
- },
- );
-
-Or, OO-ish interface
-
- use Test::TCP;
-
- my $server = Test::TCP->new(
- code => sub {
- my $port = shift;
- ...
- },
- );
- my $client = MyClient->new(host => '127.0.0.1', port => $server->port);
- undef $server; # kill child process on DESTROY
-
=head1 DESCRIPTION
-Test::TCP is test utilities for TCP/IP program.
+Test::TCP is test utilities for TCP/IP programs.
=head1 METHODS
@@ -215,6 +221,8 @@
Get the available port number, you can use.
=item test_tcp
+
+Functional interface.
test_tcp(
client => sub {
Modified: branches/upstream/libtest-tcp-perl/current/t/00_compile.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/t/00_compile.t?rev=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/t/00_compile.t (original)
+++ branches/upstream/libtest-tcp-perl/current/t/00_compile.t Fri Mar 4 19:11:11 2011
@@ -2,3 +2,5 @@
use Test::More tests => 1;
BEGIN { use_ok 'Test::TCP' }
+
+diag "Test::More: $Test::More::VERSION";
Modified: branches/upstream/libtest-tcp-perl/current/t/03_return_when_sigterm.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/t/03_return_when_sigterm.t?rev=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/t/03_return_when_sigterm.t (original)
+++ branches/upstream/libtest-tcp-perl/current/t/03_return_when_sigterm.t Fri Mar 4 19:11:11 2011
@@ -1,27 +1,40 @@
use warnings;
use strict;
-use Test::More tests => 1;
+use Test::More tests => 2;
use Test::TCP;
use t::Server;
-# ABOUT: some tcp server related software returns control when received SIGTERM
+# ABOUT: some tcp server related software returns control when received SIGTERM instead of exit.
+# This test emulate it's situation.
test_tcp(
client => sub {
ok 1;
- # nop
+ # nop... but after this statement, Test::TCP send SIGTERM to server process.
},
server => sub {
my $port = shift;
my $sock = new_sock($port);
- my $i = 0;
- $SIG{TERM} = sub { $i++ };
- while ($i == 0) {
+ my $term_received = 0;
+ $SIG{TERM} = sub { $term_received++ };
+ while ($term_received == 0) {
my $csock = $sock->accept;
if ($csock) {
$csock->close();
}
}
+
+ # suppress warnings: [Test::TCP] Child process does not block(PID: 84792, PPID: 84791)
+ # I do it on purpose!
+ $SIG{__WARN__} = sub { };
},
);
+if ($?) {
+ # It's maybe ActivePerl's bug.
+ # http://ppm4.activestate.com/MSWin32-x86/5.12/1200/T/TO/TOKUHIROM/Test-TCP-1.11.d/log-20101221T221845.txt
+ diag "test_tcp() leaks \$?. Maybe it's Perl bug?: $?";
+ $? = 0;
+}
+
+ok 1, 'test finished.';
Modified: branches/upstream/libtest-tcp-perl/current/t/04_die.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/t/04_die.t?rev=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/t/04_die.t (original)
+++ branches/upstream/libtest-tcp-perl/current/t/04_die.t Fri Mar 4 19:11:11 2011
@@ -26,3 +26,10 @@
my $killed = kill 9, $child_pid;
is $killed, 0, "already killed by test_tcp";
+if ($?) {
+ # It's maybe ActivePerl's bug.
+ # http://ppm4.activestate.com/MSWin32-x86/5.12/1200/T/TO/TOKUHIROM/Test-TCP-1.11.d/log-20101221T221845.txt
+ diag "test_tcp() leaks \$?. Maybe it's Perl bug?: $?";
+ $? = 0;
+}
+
Modified: branches/upstream/libtest-tcp-perl/current/t/06_nest.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/t/06_nest.t?rev=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/t/06_nest.t (original)
+++ branches/upstream/libtest-tcp-perl/current/t/06_nest.t Fri Mar 4 19:11:11 2011
@@ -24,3 +24,7 @@
},
);
+if ($?) {
+ diag "test_tcp() leaks \$?. Maybe it's Perl bug?: $?";
+ $? = 0;
+}
Modified: 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=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/t/09_fork.t (original)
+++ branches/upstream/libtest-tcp-perl/current/t/09_fork.t Fri Mar 4 19:11:11 2011
@@ -50,3 +50,9 @@
}
;
+if ($?) {
+ # It's maybe ActivePerl's bug.
+ # http://ppm4.activestate.com/MSWin32-x86/5.12/1200/T/TO/TOKUHIROM/Test-TCP-1.11.d/log-20101221T221845.txt
+ diag "test_tcp() leaks \$?. Maybe it's Perl bug?: $?";
+ $? = 0;
+}
Modified: branches/upstream/libtest-tcp-perl/current/t/10_oo.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tcp-perl/current/t/10_oo.t?rev=70358&op=diff
==============================================================================
--- branches/upstream/libtest-tcp-perl/current/t/10_oo.t (original)
+++ branches/upstream/libtest-tcp-perl/current/t/10_oo.t Fri Mar 4 19:11:11 2011
@@ -37,5 +37,12 @@
note "finalize";
print {$sock} "quit\n";
+if ($?) {
+ # It's maybe ActivePerl's bug.
+ # http://ppm4.activestate.com/MSWin32-x86/5.12/1200/T/TO/TOKUHIROM/Test-TCP-1.11.d/log-20101221T221845.txt
+ diag "test_tcp() leaks \$?. Maybe it's Perl bug?: $?";
+ $? = 0;
+}
+
done_testing;
More information about the Pkg-perl-cvs-commits
mailing list