r61989 - in /trunk/libtest-tcp-perl: Changes MANIFEST META.yml debian/changelog debian/control debian/copyright lib/Test/TCP.pm t/02_abrt.t t/08_exit.t
poisonbit-guest at users.alioth.debian.org
poisonbit-guest at users.alioth.debian.org
Tue Aug 24 16:49:03 UTC 2010
Author: poisonbit-guest
Date: Tue Aug 24 16:48:54 2010
New Revision: 61989
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=61989
Log:
New upstream release.
Added:
trunk/libtest-tcp-perl/t/08_exit.t
- copied unchanged from r61987, branches/upstream/libtest-tcp-perl/current/t/08_exit.t
Modified:
trunk/libtest-tcp-perl/Changes
trunk/libtest-tcp-perl/MANIFEST
trunk/libtest-tcp-perl/META.yml
trunk/libtest-tcp-perl/debian/changelog
trunk/libtest-tcp-perl/debian/control
trunk/libtest-tcp-perl/debian/copyright
trunk/libtest-tcp-perl/lib/Test/TCP.pm
trunk/libtest-tcp-perl/t/02_abrt.t
Modified: trunk/libtest-tcp-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tcp-perl/Changes?rev=61989&op=diff
==============================================================================
--- trunk/libtest-tcp-perl/Changes (original)
+++ trunk/libtest-tcp-perl/Changes Tue Aug 24 16:48:54 2010
@@ -1,4 +1,20 @@
Revision history for Perl extension Test::TCP
+
+1.03
+
+ - release to cpan
+ - fixed win32 issue(charsbar)
+
+1.02_02
+
+ - use randomness on finding empty port(suggested by kazuhooku)
+ - try to connect the port before bind(Tatsuhiko Miyagawa)
+
+1.02_01
+
+ - better cleanup code by RAII pattern.
+ https://rt.cpan.org/Ticket/Display.html?id=60657
+ (reported by dgl)
1.02
Modified: trunk/libtest-tcp-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tcp-perl/MANIFEST?rev=61989&op=diff
==============================================================================
--- trunk/libtest-tcp-perl/MANIFEST (original)
+++ trunk/libtest-tcp-perl/MANIFEST Tue Aug 24 16:48:54 2010
@@ -24,6 +24,7 @@
t/05_sigint.t
t/06_nest.t
t/07_optional.t
+t/08_exit.t
t/Server.pm
xt/01_podspell.t
xt/02_perlcritic.t
Modified: trunk/libtest-tcp-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tcp-perl/META.yml?rev=61989&op=diff
==============================================================================
--- trunk/libtest-tcp-perl/META.yml (original)
+++ trunk/libtest-tcp-perl/META.yml Tue Aug 24 16:48:54 2010
@@ -24,4 +24,4 @@
perl: 5.8.0
resources:
license: http://dev.perl.org/licenses/
-version: 1.02
+version: 1.03
Modified: trunk/libtest-tcp-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tcp-perl/debian/changelog?rev=61989&op=diff
==============================================================================
--- trunk/libtest-tcp-perl/debian/changelog (original)
+++ trunk/libtest-tcp-perl/debian/changelog Tue Aug 24 16:48:54 2010
@@ -1,3 +1,10 @@
+libtest-tcp-perl (1.02-1) unstable; urgency=low
+
+ * New upstream release.
+ * Added myself to Uploaders.
+
+ -- Iñigo Tejedor Arrondo <poisonbit at gmail.com> Thu, 24 Aug 2010 18:46:00 +0200
+
libtest-tcp-perl (1.02-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libtest-tcp-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tcp-perl/debian/control?rev=61989&op=diff
==============================================================================
--- trunk/libtest-tcp-perl/debian/control (original)
+++ trunk/libtest-tcp-perl/debian/control Tue Aug 24 16:48:54 2010
@@ -5,7 +5,7 @@
Build-Depends-Indep: perl, libtest-sharedfork-perl (>= 0.12)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Jonathan Yu <jawnsy at cpan.org>, Nicholas Bamber <nicholas at periapt.co.uk>,
- gregor herrmann <gregoa at debian.org>
+ gregor herrmann <gregoa at debian.org>, Iñigo Tejedor Arrondo <poisonbit at gmail.com>
Standards-Version: 3.9.1
Homepage: http://search.cpan.org/dist/Test-TCP/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libtest-tcp-perl/
Modified: trunk/libtest-tcp-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tcp-perl/debian/copyright?rev=61989&op=diff
==============================================================================
--- trunk/libtest-tcp-perl/debian/copyright (original)
+++ trunk/libtest-tcp-perl/debian/copyright Tue Aug 24 16:48:54 2010
@@ -27,6 +27,7 @@
Copyright: 2010, Jonathan Yu <jawnsy at cpan.org>
2010, Nicholas Bamber <nicholas at periapt.co.uk>
2010, gregor herrmann <gregoa at debian.org>
+ 2010, Iñigo Tejedor Arrondo <poisonbit at debian.org>
License: Artistic or GPL-1+
License: Artistic
Modified: trunk/libtest-tcp-perl/lib/Test/TCP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tcp-perl/lib/Test/TCP.pm?rev=61989&op=diff
==============================================================================
--- trunk/libtest-tcp-perl/lib/Test/TCP.pm (original)
+++ trunk/libtest-tcp-perl/lib/Test/TCP.pm Tue Aug 24 16:48:54 2010
@@ -2,7 +2,7 @@
use strict;
use warnings;
use 5.00800;
-our $VERSION = '1.02';
+our $VERSION = '1.03';
use base qw/Exporter/;
use IO::Socket::INET;
use Test::SharedFork;
@@ -17,10 +17,18 @@
our @EXPORT = qw/ empty_port test_tcp wait_port /;
sub empty_port {
- my $port = shift || 10000;
- $port = 19000 unless $port =~ /^[0-9]+$/ && $port < 19000;
+ my $port = do {
+ if (@_) {
+ my $p = $_[0];
+ $p = 19000 unless $p =~ /^[0-9]+$/ && $p < 19000;
+ $p;
+ } else {
+ 10000 + int(rand()*1000);
+ }
+ };
while ( $port++ < 20000 ) {
+ next if _check_port($port);
my $sock = IO::Socket::INET->new(
Listen => 5,
LocalAddr => '127.0.0.1',
@@ -44,19 +52,11 @@
# parent.
wait_port($port);
- my $sig;
- my $err;
- {
- local $SIG{INT} = sub { $sig = "INT"; die "SIGINT received\n" };
- local $SIG{PIPE} = sub { $sig = "PIPE"; die "SIGPIPE received\n" };
- eval {
- $args{client}->($port, $pid);
- };
- $err = $@;
-
+ my $guard = Test::TCP::Guard->new(code => sub {
# cleanup
kill $TERMSIG => $pid;
- while (1) {
+ local $?; # waitpid modifies original $?.
+ LOOP: while (1) {
my $kid = waitpid( $pid, 0 );
if ($^O ne 'MSWin32') { # i'm not in hell
if (WIFSIGNALED($?)) {
@@ -67,17 +67,12 @@
}
}
if ($kid == 0 || $kid == -1) {
- last;
+ last LOOP;
}
}
- }
-
- if ($sig) {
- kill $sig, $$; # rethrow signal after cleanup
- }
- if ($err) {
- die $err; # rethrow exception after cleanup.
- }
+ });
+
+ $args{client}->($port, $pid);
}
elsif ( $pid == 0 ) {
# child
@@ -115,6 +110,19 @@
Time::HiRes::sleep(0.1);
}
die "cannot open port: $port";
+}
+
+{
+ package # hide from pause
+ Test::TCP::Guard;
+ sub new {
+ my ($class, %args) = @_;
+ bless { %args }, $class;
+ }
+ sub DESTROY {
+ my ($self) = @_;
+ $self->{code}->();
+ }
}
1;
@@ -231,6 +239,8 @@
charsbar
+Tatsuhiko Miyagawa
+
=head1 SEE ALSO
=head1 LICENSE
Modified: trunk/libtest-tcp-perl/t/02_abrt.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tcp-perl/t/02_abrt.t?rev=61989&op=diff
==============================================================================
--- trunk/libtest-tcp-perl/t/02_abrt.t (original)
+++ trunk/libtest-tcp-perl/t/02_abrt.t Tue Aug 24 16:48:54 2010
@@ -1,12 +1,13 @@
use strict;
use warnings;
use Test::TCP;
-use Test::More tests => 2;
+use Test::More;
use Socket;
use IO::Socket::INET;
use t::Server;
plan skip_all => "win32 doesn't support embedded function named dump()" if $^O eq 'MSWin32';
+plan tests => 2;
test_tcp(
client => sub {
More information about the Pkg-perl-cvs-commits
mailing list