The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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' );

# Gutwrenching
is( scalar @{ $http->{connections}{"localhost:5000"} }, 2,
   '$http has two pending connections to localhost:5000' );

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' );

# Gutwrenching
is( scalar @{ $http->{connections}{"localhost:5000"} }, 1,
   '$http has only one connection to localhost:5000 at EOF' );

done_testing;