r46771 - in /branches/upstream/libio-async-perl/current: ./ lib/IO/ lib/IO/Async/ lib/IO/Async/Loop/ lib/IO/Async/Timer/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Thu Nov 5 04:28:05 UTC 2009
Author: jawnsy-guest
Date: Thu Nov 5 04:27:59 2009
New Revision: 46771
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=46771
Log:
[svn-upgrade] Integrating new upstream version, libio-async-perl (0.25)
Modified:
branches/upstream/libio-async-perl/current/Changes
branches/upstream/libio-async-perl/current/META.yml
branches/upstream/libio-async-perl/current/README
branches/upstream/libio-async-perl/current/lib/IO/Async.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/ChildManager.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Connector.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/DetachedCode.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Handle.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Listener.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Loop.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/IO_Poll.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/Poll.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/Select.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/LoopTests.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/MergePoint.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Notifier.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Resolver.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Sequencer.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Signal.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Stream.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Test.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Timer.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Timer/Countdown.pm
branches/upstream/libio-async-perl/current/lib/IO/Async/Timer/Periodic.pm
branches/upstream/libio-async-perl/current/t/18loop-select-legacy.t
branches/upstream/libio-async-perl/current/t/22timer-countdown.t
branches/upstream/libio-async-perl/current/t/22timer-periodic.t
branches/upstream/libio-async-perl/current/t/24listener.t
branches/upstream/libio-async-perl/current/t/32loop-spawnchild-setup.t
branches/upstream/libio-async-perl/current/t/35loop-child-root.t
branches/upstream/libio-async-perl/current/t/51loop-connect.t
branches/upstream/libio-async-perl/current/t/52loop-listen.t
Modified: branches/upstream/libio-async-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/Changes?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/Changes (original)
+++ branches/upstream/libio-async-perl/current/Changes Thu Nov 5 04:27:59 2009
@@ -1,4 +1,14 @@
Revision history for IO-Async
+
+0.25 CHANGES:
+ * Accept 'stream'/'dgram'/'raw' as symbolic shortcuts for socket
+ types in connect/listen operations - avoids 'use Socket'
+ * Accept IO::Handle-derived objects in ChildManager setup keys as
+ well as raw GLOB refs
+
+ BUGFIXES:
+ * Various changes to test scripts to hopefully improve portability or
+ reliability during smoke tests
0.24 ADDITIONS:
* Timer subclasses - Countdown and Periodic
Modified: branches/upstream/libio-async-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/META.yml?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/META.yml (original)
+++ branches/upstream/libio-async-perl/current/META.yml Thu Nov 5 04:27:59 2009
@@ -1,6 +1,6 @@
---
name: IO-Async
-version: 0.24
+version: 0.25
author:
- 'Paul Evans <leonerd at leonerd.org.uk>'
abstract: perform asynchronous filehandle IO and other operations
@@ -24,67 +24,67 @@
provides:
IO::Async:
file: lib/IO/Async.pm
- version: 0.24
+ version: 0.25
IO::Async::ChildManager:
file: lib/IO/Async/ChildManager.pm
- version: 0.24
+ version: 0.25
IO::Async::Connector:
file: lib/IO/Async/Connector.pm
- version: 0.24
+ version: 0.25
IO::Async::DetachedCode:
file: lib/IO/Async/DetachedCode.pm
- version: 0.24
+ version: 0.25
IO::Async::Handle:
file: lib/IO/Async/Handle.pm
- version: 0.24
+ version: 0.25
IO::Async::Listener:
file: lib/IO/Async/Listener.pm
- version: 0.24
+ version: 0.25
IO::Async::Loop:
file: lib/IO/Async/Loop.pm
- version: 0.24
+ version: 0.25
IO::Async::Loop::IO_Poll:
file: lib/IO/Async/Loop/IO_Poll.pm
- version: 0.24
+ version: 0.25
IO::Async::Loop::Poll:
file: lib/IO/Async/Loop/Poll.pm
- version: 0.24
+ version: 0.25
IO::Async::Loop::Select:
file: lib/IO/Async/Loop/Select.pm
- version: 0.24
+ version: 0.25
IO::Async::LoopTests:
file: lib/IO/Async/LoopTests.pm
- version: 0.24
+ version: 0.25
IO::Async::MergePoint:
file: lib/IO/Async/MergePoint.pm
- version: 0.24
+ version: 0.25
IO::Async::Notifier:
file: lib/IO/Async/Notifier.pm
- version: 0.24
+ version: 0.25
IO::Async::Resolver:
file: lib/IO/Async/Resolver.pm
- version: 0.24
+ version: 0.25
IO::Async::Sequencer:
file: lib/IO/Async/Sequencer.pm
- version: 0.24
+ version: 0.25
IO::Async::Signal:
file: lib/IO/Async/Signal.pm
- version: 0.24
+ version: 0.25
IO::Async::Stream:
file: lib/IO/Async/Stream.pm
- version: 0.24
+ version: 0.25
IO::Async::Test:
file: lib/IO/Async/Test.pm
- version: 0.24
+ version: 0.25
IO::Async::Timer:
file: lib/IO/Async/Timer.pm
- version: 0.24
+ version: 0.25
IO::Async::Timer::Countdown:
file: lib/IO/Async/Timer/Countdown.pm
- version: 0.24
+ version: 0.25
IO::Async::Timer::Periodic:
file: lib/IO/Async/Timer/Periodic.pm
- version: 0.24
+ version: 0.25
generated_by: Module::Build version 0.35
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
Modified: branches/upstream/libio-async-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/README?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/README (original)
+++ branches/upstream/libio-async-perl/current/README Thu Nov 5 04:27:59 2009
@@ -5,14 +5,12 @@
use IO::Async::Stream;
use IO::Async::Loop;
- use Socket qw( SOCK_STREAM );
-
my $loop = IO::Async::Loop->new();
$loop->connect(
host => "some.other.host",
service => 12345,
- socktype => SOCK_STREAM,
+ socktype => 'stream',
on_connected => sub {
my ( $socket ) = @_;
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async.pm Thu Nov 5 04:27:59 2009
@@ -12,7 +12,7 @@
# It is provided simply to keep CPAN happy:
# cpan -i IO::Async
-our $VERSION = '0.24';
+our $VERSION = '0.25';
=head1 NAME
@@ -22,15 +22,13 @@
use IO::Async::Stream;
use IO::Async::Loop;
-
- use Socket qw( SOCK_STREAM );
my $loop = IO::Async::Loop->new();
$loop->connect(
host => "some.other.host",
service => 12345,
- socktype => SOCK_STREAM,
+ socktype => 'stream',
on_connected => sub {
my ( $socket ) = @_;
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/ChildManager.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/ChildManager.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/ChildManager.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/ChildManager.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
# Not a notifier
@@ -408,6 +408,9 @@
C<IO::Async> will B<NOT> check before detaching the child process whether
this is the case.
+If setting both the primary GID and the supplementary groups list, it is
+suggested to set the primary GID first.
+
=back
If no directions for what to do with C<stdin>, C<stdout> and C<stderr> are
@@ -431,6 +434,8 @@
my @setup;
+ my $has_setgroups;
+
foreach my $i ( 0 .. $#$setup / 2 ) {
my ( $key, $value ) = @$setup[$i*2, $i*2 + 1];
@@ -452,7 +457,7 @@
elsif( $ref eq "ARRAY" ) {
# Already OK
}
- elsif( $ref eq "GLOB" ) {
+ elsif( $ref eq "GLOB" or eval { $value->isa( "IO::Handle" ) } ) {
$value = [ 'dup', $value ];
}
else {
@@ -480,10 +485,12 @@
}
elsif( $key eq "setgid" ) {
$value =~ m/^\d+$/ or croak "Expected integer for 'setgid' setup key";
+ $has_setgroups and carp "It is suggested to 'setgid' before 'setgroups'";
}
elsif( $key eq "setgroups" ) {
ref $value eq "ARRAY" or croak "Expected ARRAY reference for 'setgroups' setup key";
m/^\d+$/ or croak "Expected integer in 'setgroups' array" for @$value;
+ $has_setgroups = 1;
}
else {
croak "Unrecognised setup operation '$key'";
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Connector.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Connector.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Connector.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Connector.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use POSIX qw( EINPROGRESS );
use Socket qw( SOL_SOCKET SO_ERROR );
@@ -22,8 +22,6 @@
=head1 SYNOPSIS
This object is used indirectly via an C<IO::Async::Loop>:
-
- use Socket qw( SOCK_STREAM );
use IO::Async::Loop;
my $loop = IO::Async::Loop->new();
@@ -31,7 +29,7 @@
$loop->connect(
host => "www.example.com",
service => "http",
- socktype => SOCK_STREAM,
+ socktype => 'stream',
on_connected => sub {
my ( $sock ) = @_;
@@ -277,6 +275,13 @@
Optional. Other arguments to pass along with C<host> and C<service> to the
C<getaddrinfo()> call.
+
+=item socktype => STRING
+
+Optionally may instead be one of the values C<'stream'>, C<'dgram'> or
+C<'raw'> to stand for C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_RAW>. This
+utility is provided to allow the caller to avoid a separate C<use Socket> only
+for importing these constants.
=item on_resolve_error => CODE
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/DetachedCode.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/DetachedCode.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/DetachedCode.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/DetachedCode.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use IO::Async::Stream;
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Handle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Handle.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Handle.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Handle.pm Thu Nov 5 04:27:59 2009
@@ -9,7 +9,7 @@
use warnings;
use base qw( IO::Async::Notifier );
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use Carp;
use Scalar::Util qw( weaken );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Listener.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Listener.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Listener.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Listener.pm Thu Nov 5 04:27:59 2009
@@ -9,7 +9,7 @@
use warnings;
use base qw( IO::Async::Handle );
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use IO::Async::Handle;
@@ -25,8 +25,6 @@
C<IO::Async::Listener> - listen on network sockets for incoming connections
=head1 SYNOPSIS
-
- use Socket qw( SOCK_STREAM );
use IO::Async::Listener;
use IO::Async::Stream;
@@ -55,7 +53,7 @@
$listener->listen(
service => "echo",
- socktype => SOCK_STREAM,
+ socktype => 'stream',
on_resolve_error => sub { print STDERR "Cannot resolve - $_[0]\n"; },
on_listen_error => sub { print STDERR "Cannot listen\n"; },
@@ -65,8 +63,6 @@
This object can also be used indirectly via an C<IO::Async::Loop>:
- use Socket qw( SOCK_STREAM );
-
use IO::Async::Stream;
use IO::Async::Loop;
@@ -74,7 +70,7 @@
$loop->listen(
service => "echo",
- socktype => SOCK_STREAM,
+ socktype => 'stream',
on_accept => sub {
...
@@ -278,6 +274,13 @@
Optional. Other arguments to pass along with C<host> and C<service> to the
C<getaddrinfo()> call.
+=item socktype => STRING
+
+Optionally may instead be one of the values C<'stream'>, C<'dgram'> or
+C<'raw'> to stand for C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_RAW>. This
+utility is provided to allow the caller to avoid a separate C<use Socket> only
+for importing these constants.
+
=item on_resolve_error => CODE
A continuation that is invoked when the name resolution attempt fails. This is
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Loop.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Loop.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Loop.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Loop.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use constant NEED_API_VERSION => '0.24';
use Carp;
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/IO_Poll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/IO_Poll.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/IO_Poll.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/IO_Poll.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use base qw( IO::Async::Loop::Poll );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/Poll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/Poll.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/Poll.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/Poll.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use constant API_VERSION => '0.24';
use base qw( IO::Async::Loop );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/Select.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/Select.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/Select.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Loop/Select.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use constant API_VERSION => '0.24';
use base qw( IO::Async::Loop );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/LoopTests.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/LoopTests.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/LoopTests.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/LoopTests.pm Thu Nov 5 04:27:59 2009
@@ -22,7 +22,7 @@
use POSIX qw( SIGTERM WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG );
use Time::HiRes qw( time );
-our $VERSION = '0.24';
+our $VERSION = '0.25';
# Abstract Units of Time
use constant AUT => $ENV{TEST_QUICK_TIMERS} ? 0.1 : 1;
@@ -264,7 +264,7 @@
die "It should have been ready by now" if( time - $now > 5 * AUT );
$loop->loop_once( 0.1 * AUT );
}
- } 1.9, 2.5, 'loop_once(5) while waiting for timer';
+ } 1.5, 2.5, 'loop_once(5) while waiting for timer';
my $cancelled_fired = 0;
my $id = $loop->enqueue_timer( delay => 1 * AUT, code => sub { $cancelled_fired = 1 } );
@@ -294,7 +294,7 @@
die "It should have been ready by now" if( time - $now > 5 * AUT );
$loop->loop_once( 0.1 * AUT );
}
- } 1.9, 2.5, 'requeued timer of delay 2';
+ } 1.5, 2.5, 'requeued timer of delay 2';
is( $done, 2, '$done is 2 after requeued timer' );
}
@@ -399,7 +399,7 @@
$loop->unwatch_idle( $id );
- time_between { $loop->loop_once( 1 * AUT ) } 0.9, 1.1, 'loop_once(1) with unwatched deferral';
+ time_between { $loop->loop_once( 1 * AUT ) } 0.5, 1.5, 'loop_once(1) with unwatched deferral';
is( $called, 2, 'unwatched deferral not called' );
@@ -438,6 +438,11 @@
ok( WIFEXITED($exitcode), 'WIFEXITED($exitcode) after child exit' );
is( WEXITSTATUS($exitcode), 3, 'WEXITSTATUS($exitcode) after child exit' );
+
+ # We require that SIGTERM perform its default action; i.e. terminate the
+ # process. Ensure this definitely happens, in case the test harness has it
+ # ignored or handled elsewhere.
+ local $SIG{TERM} = "DEFAULT";
$kid = fork();
defined $kid or die "Cannot fork() - $!";
@@ -468,7 +473,7 @@
use constant count_tests_control => 3;
sub run_tests_control
{
- time_between { $loop->loop_once( 2 * AUT ) } 1.9, 2.5, 'loop_once(2) when idle';
+ time_between { $loop->loop_once( 2 * AUT ) } 1.5, 2.5, 'loop_once(2) when idle';
$loop->later( sub { $loop->loop_stop } );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/MergePoint.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/MergePoint.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/MergePoint.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/MergePoint.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use Carp;
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Notifier.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Notifier.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Notifier.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Notifier.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use Carp;
use Scalar::Util qw( weaken );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Resolver.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Resolver.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Resolver.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Resolver.pm Thu Nov 5 04:27:59 2009
@@ -8,9 +8,10 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use Socket::GetAddrInfo qw( :Socket6api getaddrinfo getnameinfo );
+use Socket qw( SOCK_STREAM SOCK_DGRAM SOCK_RAW );
use Carp;
@@ -249,9 +250,15 @@
=cut
register_resolver( 'getaddrinfo', sub {
- my @args = @_;
-
- my @res = getaddrinfo( @args );
+ my ( $host, $service, $family, $socktype, $protocol, $flags ) = @_;
+
+ if( defined $socktype ) {
+ $socktype = SOCK_STREAM if $socktype eq 'stream';
+ $socktype = SOCK_DGRAM if $socktype eq 'dgram';
+ $socktype = SOCK_RAW if $socktype eq 'raw';
+ }
+
+ my @res = getaddrinfo( $host, $service, $family, $socktype, $protocol, $flags );
# getaddrinfo() uses a 1-element list as an error value
die "$res[0]\n" if @res == 1;
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Sequencer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Sequencer.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Sequencer.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Sequencer.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use base qw( IO::Async::Stream );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Signal.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Signal.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Signal.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Signal.pm Thu Nov 5 04:27:59 2009
@@ -9,7 +9,7 @@
use warnings;
use base qw( IO::Async::Notifier );
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use Carp;
use Scalar::Util qw( weaken );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Stream.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Stream.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Stream.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Stream.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use base qw( IO::Async::Handle );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Test.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Test.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Test.pm Thu Nov 5 04:27:59 2009
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use Exporter;
our @ISA = qw( Exporter );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Timer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Timer.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Timer.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Timer.pm Thu Nov 5 04:27:59 2009
@@ -9,7 +9,7 @@
use warnings;
use base qw( IO::Async::Notifier );
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use Carp;
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Timer/Countdown.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Timer/Countdown.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Timer/Countdown.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Timer/Countdown.pm Thu Nov 5 04:27:59 2009
@@ -9,7 +9,7 @@
use warnings;
use base qw( IO::Async::Timer );
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use Carp;
use Scalar::Util qw( weaken );
Modified: branches/upstream/libio-async-perl/current/lib/IO/Async/Timer/Periodic.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/lib/IO/Async/Timer/Periodic.pm?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/lib/IO/Async/Timer/Periodic.pm (original)
+++ branches/upstream/libio-async-perl/current/lib/IO/Async/Timer/Periodic.pm Thu Nov 5 04:27:59 2009
@@ -9,7 +9,7 @@
use warnings;
use base qw( IO::Async::Timer );
-our $VERSION = '0.24';
+our $VERSION = '0.25';
use Carp;
use Scalar::Util qw( weaken );
@@ -31,7 +31,6 @@
on_tick => sub {
print "You've had a minute\n";
- $loop->loop_stop;
},
);
Modified: branches/upstream/libio-async-perl/current/t/18loop-select-legacy.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/t/18loop-select-legacy.t?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/t/18loop-select-legacy.t (original)
+++ branches/upstream/libio-async-perl/current/t/18loop-select-legacy.t Thu Nov 5 04:27:59 2009
@@ -102,7 +102,7 @@
$loop->enqueue_timer( delay => 2 * AUT, code => sub { $done = 1; } );
$loop->pre_select( \$rvec, \$wvec, \$evec, \$timeout );
-cmp_ok( $timeout/AUT, '>', 1.9, '$timeout while timer waiting pre_select at least 1.9' );
+cmp_ok( $timeout/AUT, '>', 1.7, '$timeout while timer waiting pre_select at least 1.7' );
cmp_ok( $timeout/AUT, '<', 2.5, '$timeout while timer waiting pre_select at least 2.5' );
my ( $now, $took );
@@ -111,7 +111,7 @@
select( $rvec, $wvec, $evec, $timeout );
$took = (time - $now) / AUT;
-cmp_ok( $took, '>', 1.9, 'loop_once(5) while waiting for timer takes at least 1.9 seconds' );
+cmp_ok( $took, '>', 1.7, 'loop_once(5) while waiting for timer takes at least 1.7 seconds' );
cmp_ok( $took, '<', 10, 'loop_once(5) while waiting for timer no more than 10 seconds' );
if( $took > 2.5 ) {
diag( "took more than 2.5 seconds to select().\n" .
Modified: branches/upstream/libio-async-perl/current/t/22timer-countdown.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/t/22timer-countdown.t?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/t/22timer-countdown.t (original)
+++ branches/upstream/libio-async-perl/current/t/22timer-countdown.t Thu Nov 5 04:27:59 2009
@@ -17,9 +17,13 @@
use constant AUT => $ENV{TEST_QUICK_TIMERS} ? 0.1 : 1;
# Kindof like Test::Timer only we use Time::HiRes
-sub time_between
+# We'll be quite lenient on the time taken, in case of heavy test machine load
+sub time_about
{
- my ( $code, $lower, $upper, $name ) = @_;
+ my ( $code, $target, $name ) = @_;
+
+ my $lower = $target*0.75;
+ my $upper = $target*1.5 + 1;
my $now = time;
$code->();
@@ -56,8 +60,7 @@
ok( $timer->is_running, 'Started Timer is running' );
-time_between( sub { wait_for { $expired } },
- 1.5, 2.5, 'Timer works' );
+time_about( sub { wait_for { $expired } }, 2, 'Timer works' );
ok( !$timer->is_running, 'Expired Timer is no longer running' );
@@ -73,8 +76,7 @@
$timer->start;
-time_between( sub { wait_for { $expired } },
- 1.5, 2.5, 'Timer works a second time' );
+time_about( sub { wait_for { $expired } }, 2, 'Timer works a second time' );
undef $expired;
$timer->start;
@@ -120,24 +122,21 @@
ok( $timer->is_running, 'Pre-started Timer is running after adding' );
-time_between( sub { wait_for { $expired } },
- 1.5, 2.5, 'Pre-started Timer works' );
+time_about( sub { wait_for { $expired } }, 2, 'Pre-started Timer works' );
$timer->configure( delay => 1 * AUT );
undef $expired;
$timer->start;
-time_between( sub { wait_for { $expired } },
- 0.5, 1.5, 'Reconfigured timer delay works' );
+time_about( sub { wait_for { $expired } }, 1, 'Reconfigured timer delay works' );
my $new_expired;
$timer->configure( on_expire => sub { $new_expired = 1 } );
$timer->start;
-time_between( sub { wait_for { $new_expired } },
- 0.5, 1.5, 'Reconfigured timer on_expire works' );
+time_about( sub { wait_for { $new_expired } }, 1, 'Reconfigured timer on_expire works' );
$timer->start;
dies_ok( sub { $timer->configure( delay => 5 ); },
@@ -172,8 +171,7 @@
ok( $timer->is_running, 'Started subclass Timer is running' );
-time_between( sub { wait_for { $sub_expired } },
- 1.5, 2.5, 'subclass Timer works' );
+time_about( sub { wait_for { $sub_expired } }, 2, 'subclass Timer works' );
ok( !$timer->is_running, 'Expired subclass Timer is no longer running' );
Modified: branches/upstream/libio-async-perl/current/t/22timer-periodic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/t/22timer-periodic.t?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/t/22timer-periodic.t (original)
+++ branches/upstream/libio-async-perl/current/t/22timer-periodic.t Thu Nov 5 04:27:59 2009
@@ -17,9 +17,13 @@
use constant AUT => $ENV{TEST_QUICK_TIMERS} ? 0.1 : 1;
# Kindof like Test::Timer only we use Time::HiRes
-sub time_between
+# We'll be quite lenient on the time taken, in case of heavy test machine load
+sub time_about
{
- my ( $code, $lower, $upper, $name ) = @_;
+ my ( $code, $target, $name ) = @_;
+
+ my $lower = $target*0.75;
+ my $upper = $target*1.5 + 1;
my $now = time;
$code->();
@@ -56,13 +60,11 @@
ok( $timer->is_running, 'Started Timer is running' );
-time_between( sub { wait_for { $tick == 1 } },
- 1.5, 2.5, 'Timer works' );
+time_about( sub { wait_for { $tick == 1 } }, 2, 'Timer works' );
ok( $timer->is_running, 'Timer is still running' );
-time_between( sub { wait_for { $tick == 2 } },
- 1.5, 2.5, 'Timer works a second time' );
+time_about( sub { wait_for { $tick == 2 } }, 2, 'Timer works a second time' );
$loop->loop_once( 1 * AUT );
@@ -86,8 +88,7 @@
$timer->start;
-time_between( sub { wait_for { $tick == 3 } },
- 0.5, 1.5, 'Reconfigured timer interval works' );
+time_about( sub { wait_for { $tick == 3 } }, 1, 'Reconfigured timer interval works' );
dies_ok( sub { $timer->configure( interval => 5 ); },
'Configure a running timer fails' );
@@ -121,8 +122,7 @@
ok( $timer->is_running, 'Started subclass Timer is running' );
-time_between( sub { wait_for { $sub_tick == 1 } },
- 1.5, 2.5, 'subclass Timer works' );
+time_about( sub { wait_for { $sub_tick == 1 } }, 2, 'subclass Timer works' );
is_refcount( $timer, 2, 'subclass $timer has refcount 2 before removing from Loop' );
Modified: branches/upstream/libio-async-perl/current/t/24listener.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/t/24listener.t?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/t/24listener.t (original)
+++ branches/upstream/libio-async-perl/current/t/24listener.t Thu Nov 5 04:27:59 2009
@@ -80,7 +80,7 @@
is_refcount( $listener, 2, 'subclass $listener has refcount 2 after adding to Loop' );
-$clientsock = IO::Socket::INET->new( Type => SOCK_STREAM )
+$clientsock = IO::Socket::INET->new( LocalAddr => "127.0.0.1", Type => SOCK_STREAM )
or die "Cannot socket() - $!";
$clientsock->connect( $listensock->sockname ) or die "Cannot connect() - $!";
Modified: branches/upstream/libio-async-perl/current/t/32loop-spawnchild-setup.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/t/32loop-spawnchild-setup.t?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/t/32loop-spawnchild-setup.t (original)
+++ branches/upstream/libio-async-perl/current/t/32loop-spawnchild-setup.t Thu Nov 5 04:27:59 2009
@@ -4,7 +4,7 @@
use IO::Async::Test;
-use Test::More tests => 107;
+use Test::More tests => 112;
use Test::Exception;
use File::Temp qw( tmpnam );
@@ -288,6 +288,26 @@
is( $buffer, 'outputerror', '$buffer after pipe dup to stdout and stderr same pipe' );
}
+{
+ my ( $child_r, $my_w, $my_r, $child_w ) = $loop->pipequad() or die "Cannot pipequad - $!";
+
+ $my_w->syswrite( "hello\n" );
+
+ TEST "pipe quad to fd0/fd1",
+ setup => [ stdin => $child_r,
+ stdout => $child_w, ],
+ code => sub { print uc scalar <STDIN>; return 0 },
+
+ exitstatus => 0,
+ dollarat => '';
+
+ my $buffer;
+ $ret = read_timeout( $my_r, $buffer, 6, 0.1 );
+
+ is( $ret, 6, '$my_r->read() after pipe quad to fd0/fd1' );
+ is( $buffer, "HELLO\n", '$buffer after pipe quad to fd0/fd1' );
+}
+
TEST "stdout close",
setup => [ stdout => [ 'close' ] ],
code => sub { print "test"; },
Modified: branches/upstream/libio-async-perl/current/t/35loop-child-root.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/t/35loop-child-root.t?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/t/35loop-child-root.t (original)
+++ branches/upstream/libio-async-perl/current/t/35loop-child-root.t Thu Nov 5 04:27:59 2009
@@ -65,14 +65,14 @@
$loop->run_child(
code => sub {
print "EUID: $>\n";
- my ( $gid, $groups ) = split( m/ /, $), 2 );
+ my ( $gid, @groups ) = split( m/ /, $) );
print "EGID: $gid\n";
- print "Groups: $groups\n";
+ print "Groups: " . join( " ", sort { $a <=> $b } @groups ) . "\n";
return 0;
},
setup => [
+ setgid => 10,
setgroups => [ 4, 5, 6, 10 ],
- setgid => 10,
setuid => 20,
],
on_finish => sub { ( undef, $exitcode, $child_out ) = @_; },
Modified: branches/upstream/libio-async-perl/current/t/51loop-connect.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/t/51loop-connect.t?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/t/51loop-connect.t (original)
+++ branches/upstream/libio-async-perl/current/t/51loop-connect.t Thu Nov 5 04:27:59 2009
@@ -57,24 +57,29 @@
$listensock->accept; # Throw it away
undef $sock; # This too
-# Now try an address we know to be invalid - a UNIX socket that doesn't exist
+SKIP: {
+ # Now try an address we know to be invalid - a UNIX socket that doesn't exist
-my $error;
+ socket( my $dummy, AF_UNIX, SOCK_STREAM, 0 ) or
+ skip "Cannot create AF_UNIX sockets - $!", 2;
-my $failop;
-my $failerr;
+ my $error;
-$loop->connect(
- addr => [ AF_UNIX, SOCK_STREAM, 0, pack_sockaddr_un( "/some/path/we/know/breaks" ) ],
- on_connected => sub { die "Test died early - connect succeeded\n"; },
- on_fail => sub { $failop = shift @_; $failerr = pop @_; },
- on_connect_error => sub { $error = 1 },
-);
+ my $failop;
+ my $failerr;
-wait_for { $error };
+ $loop->connect(
+ addr => [ AF_UNIX, SOCK_STREAM, 0, pack_sockaddr_un( "/some/path/we/know/breaks" ) ],
+ on_connected => sub { die "Test died early - connect succeeded\n"; },
+ on_fail => sub { $failop = shift @_; $failerr = pop @_; },
+ on_connect_error => sub { $error = 1 },
+ );
-is( $failop, "connect", '$failop is connect' );
-is( $failerr+0, ENOENT, '$failerr is ENOENT' );
+ wait_for { $error };
+
+ is( $failop, "connect", '$failop is connect' );
+ is( $failerr+0, ENOENT, '$failerr is ENOENT' );
+}
# UNIX sockets always connect() synchronously, meaning if they fail, the error
# is available immediately. The above has therefore not properly tested
@@ -98,10 +103,10 @@
SKIP: {
skip "Cannot find an un-connect()able socket on 127.0.0.1", 2 unless defined $port;
- undef $failop;
- undef $failerr;
+ my $failop;
+ my $failerr;
- $error = 0;
+ my $error = 0;
$loop->connect(
addr => [ AF_INET, SOCK_STREAM, 0, pack_sockaddr_in( $port, inet_aton("127.0.0.1") ) ],
Modified: branches/upstream/libio-async-perl/current/t/52loop-listen.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-async-perl/current/t/52loop-listen.t?rev=46771&op=diff
==============================================================================
--- branches/upstream/libio-async-perl/current/t/52loop-listen.t (original)
+++ branches/upstream/libio-async-perl/current/t/52loop-listen.t Thu Nov 5 04:27:59 2009
@@ -57,7 +57,7 @@
$loop->listen(
family => AF_INET,
- socktype => SOCK_STREAM,
+ socktype => 'stream',
service => 0, # Ask the kernel to allocate a port for us
host => "localhost",
@@ -125,7 +125,7 @@
$loop->listen(
family => AF_INET,
- socktype => SOCK_STREAM,
+ socktype => 'stream',
service => $badport,
on_resolve_error => sub { die "Test died early - resolve error $_[0]\n"; },
More information about the Pkg-perl-cvs-commits
mailing list