=== modified file 'lib/Net/Async/HTTP.pm'
--- lib/Net/Async/HTTP.pm 2014-11-28 17:27:58 +0000
+++ lib/Net/Async/HTTP.pm 2014-12-01 17:35:30 +0000
@@ -389,8 +389,6 @@
return $f;
}
- $ready->connecting++;
-
my $conn = Net::Async::HTTP::Connection->new(
notifier_name => "$host:$port,connecting",
ready_queue => $ready_queue,
@@ -414,7 +412,7 @@
$self->add_child( $conn );
push @$conns, $conn;
- $self->connect_connection( %args,
+ $ready->connecting = $self->connect_connection( %args,
conn => $conn,
on_error => sub {
my $conn = shift;
=== modified file 'lib/Net/Async/HTTP/Connection.pm'
--- lib/Net/Async/HTTP/Connection.pm 2014-11-25 13:19:38 +0000
+++ lib/Net/Async/HTTP/Connection.pm 2014-12-01 17:35:30 +0000
@@ -110,18 +110,24 @@
if( $self->should_pipeline ) {
$self->debug_printf( "READY pipelined" );
while( @$queue && $self->should_pipeline ) {
- my $f = ( shift @$queue )->future;
+ my $ready = shift @$queue;
+ my $f = $ready->future;
next if $f->is_cancelled;
+ $ready->connecting and $ready->connecting->cancel;
+
$f->done( $self );
}
}
elsif( @$queue and $self->is_idle ) {
$self->debug_printf( "READY non-pipelined" );
while( @$queue ) {
- my $f = ( shift @$queue )->future;
+ my $ready = shift @$queue;
+ my $f = $ready->future;
next if $f->is_cancelled;
+ $ready->connecting and $ready->connecting->cancel;
+
$f->done( $self );
last;
}
=== added file 't/90rt99142.t'
--- t/90rt99142.t 1970-01-01 00:00:00 +0000
+++ t/90rt99142.t 2014-12-01 17:35:30 +0000
@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use IO::Async::Test;
+use IO::Async::Loop;
+
+use Net::Async::HTTP;
+
+my $CRLF = "\x0d\x0a"; # because \r\n isn't portable
+
+my $loop = IO::Async::Loop->new();
+testing_loop( $loop );
+
+my $http = Net::Async::HTTP->new(
+ user_agent => "", # Don't put one in request headers
+ max_connections_per_host => 2,
+);
+
+$loop->add( $http );
+
+{
+ my @pending;
+ no warnings 'redefine';
+ *IO::Async::Handle::connect = sub {
+ my $self = shift;
+ my %args = @_;
+ $args{host} eq "localhost" or die "Cannot fake connect - expected host 'localhost'";
+ $args{service} eq "5000" or die "Cannot fake connect - expected service '5000'";
+
+ push @pending, [ $self, my $f = $loop->new_future ];
+ return $f;
+ };
+
+ sub await_connection
+ {
+ wait_for { scalar @pending };
+
+ return @{ shift @pending };
+ }
+}
+
+# Make a first connection
+my $req_f1 = $http->GET( "
http://localhost:5000/1" );
+my $peersock;
+{
+ my ( $conn, $conn_f ) = await_connection;
+
+ ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!";
+ $conn->set_handle( $selfsock );
+
+ $conn_f->done( $conn );
+}
+
+# Before the first is ready, make a second one
+my $req_f2 = $http->GET( "
http://localhost:5000/2" );
+my ( $conn2, $conn_f2 ) = await_connection;
+ok( $conn_f2, 'Second connection request is pending' );
+
+my $request_stream = "";
+wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream;
+
+like( $request_stream, qr(^GET /1), 'First request written' );
+$request_stream = "";
+
+# Respond with HTTP/1.1 so client knows it can pipeline
+$peersock->syswrite( "HTTP/1.1 200 OK$CRLF" .
+ "Content-Length: 0$CRLF" .
+ $CRLF );
+
+wait_for { $req_f1->is_ready };
+ok( $req_f1->is_done, '$req_f1 is done after first response' );
+
+# At this point, req 2 should already be made down the socket
+wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream;
+
+like( $request_stream, qr(^GET /2), 'Second request written down first socket' );
+
+# And $conn_f2 should already be cancelled
+ok( $conn_f2->is_cancelled, '$conn_f2 now cancelled' );
+
+done_testing;
