IO-Async-0.800/t/20handle.t

#!/usr/bin/perl

use strict;
use warnings;

use IO::Async::Test;

use Test::More;
use Test::Fatal;
use Test::Identity;
use Test::Refcount;

use IO::Async::Loop;

use IO::Async::Handle;

use IO::Async::OS;

use Socket qw( AF_INET SOCK_STREAM SOCK_DGRAM SO_TYPE unpack_sockaddr_in );

my $loop = IO::Async::Loop->new_builtin;

testing_loop( $loop );

sub mkhandles
{
   my ( $S1, $S2 ) = IO::Async::OS->socketpair or die "Cannot create socket pair - $!";

   # Need sockets in nonblocking mode
   $S1->blocking( 0 );
   $S2->blocking( 0 );

   return ( $S1, $S2 );
}

ok( exception { IO::Async::Handle->new( handle => "Hello" ) }, 'Not a filehandle' );

# Read readiness
{
   my ( $S1, $S2 ) = mkhandles;
   my $fd1 = $S1->fileno;

   my $readready = 0;
   my @rrargs;

   my $handle = IO::Async::Handle->new(
      read_handle => $S1,
      on_read_ready  => sub { @rrargs = @_; $readready = 1 },
   );

   ok( defined $handle, '$handle defined' );
   isa_ok( $handle, "IO::Async::Handle", '$handle isa IO::Async::Handle' );

   is( $handle->notifier_name, "r=$fd1", '$handle->notifier_name for read_handle' );

   is_oneref( $handle, '$handle has refcount 1 initially' );

   is( $handle->read_handle,  $S1, '->read_handle returns S1' );
   is( $handle->read_fileno,  $S1->fileno, '->read_fileno returns fileno(S1)' );

   is( $handle->write_handle, undef, '->write_handle returns undef' );

   ok( $handle->want_readready, 'want_readready true' );

   $loop->add( $handle );

   is_refcount( $handle, 2, '$handle has refcount 2 after adding to Loop' );

   $loop->loop_once( 0.1 ); # nothing happens

   is( $readready,  0, '$readready while idle' );

   $S2->syswrite( "data\n" );

   wait_for { $readready };

   is( $readready,  1, '$readready while readable' );
   is_deeply( \@rrargs, [ $handle ], 'on_read_ready args while readable' );

   $S1->getline; # ignore return

   $readready = 0;
   my $new_readready = 0;

   $handle->configure( on_read_ready => sub { $new_readready = 1 } );

   $loop->loop_once( 0.1 ); # nothing happens

   is( $readready,     0, '$readready while idle after on_read_ready replace' );
   is( $new_readready, 0, '$new_readready while idle after on_read_ready replace' );

   $S2->syswrite( "data\n" );

   wait_for { $new_readready };

   is( $readready,     0, '$readready while readable after on_read_ready replace' );
   is( $new_readready, 1, '$new_readready while readable after on_read_ready replace' );

   $S1->getline; # ignore return

   ok( exception { $handle->want_writeready( 1 ); },
       'setting want_writeready with write_handle == undef dies' );
   ok( !$handle->want_writeready, 'wantwriteready write_handle == undef false' );

   undef @rrargs;

   is_refcount( $handle, 2, '$handle has refcount 2 before removing from Loop' );

   $loop->remove( $handle );

   is_oneref( $handle, '$handle has refcount 1 finally' );
}

# Write readiness
{
   my ( $S1, $S2 ) = mkhandles;
   my $fd1 = $S1->fileno;

   my $writeready = 0;
   my @wrargs;

   my $handle = IO::Async::Handle->new(
      write_handle => $S1,
      on_write_ready => sub { @wrargs = @_; $writeready = 1 },
   );

   ok( defined $handle, '$handle defined' );
   isa_ok( $handle, "IO::Async::Handle", '$handle isa IO::Async::Handle' );

   is( $handle->notifier_name, "w=$fd1", '$handle->notifier_name for write_handle' );

   is_oneref( $handle, '$handle has refcount 1 initially' );

   is( $handle->write_handle, $S1, '->write_handle returns S1' );
   is( $handle->write_fileno, $S1->fileno, '->write_fileno returns fileno(S1)' );

   is( $handle->read_handle, undef, '->read_handle returns undef' );

   ok( !$handle->want_writeready, 'want_writeready false' );

   $loop->add( $handle );

   is_refcount( $handle, 2, '$handle has refcount 2 after adding to Loop' );

   $loop->loop_once( 0.1 ); # nothing happens

   is( $writeready, 0, '$writeready while idle' );

   $handle->want_writeready( 1 );

   wait_for { $writeready };

   is( $writeready, 1, '$writeready while writeable' );
   is_deeply( \@wrargs, [ $handle ], 'on_write_ready args while writeable' );

   $writeready = 0;
   my $new_writeready = 0;

   $handle->configure( on_write_ready => sub { $new_writeready = 1 } );

   wait_for { $new_writeready };

   is( $writeready,     0, '$writeready while writeable after on_write_ready replace' );
   is( $new_writeready, 1, '$new_writeready while writeable after on_write_ready replace' );

   undef @wrargs;

   is_refcount( $handle, 2, '$handle has refcount 2 before removing from Loop' );

   $loop->remove( $handle );

   is_oneref( $handle, '$handle has refcount 1 finally' );
}

# Combined handle
{
   my ( $S1, $S2 ) = mkhandles;
   my $fd1 = $S1->fileno;

   my $handle = IO::Async::Handle->new(
      handle => $S1,
      on_read_ready  => sub {},
      on_write_ready => sub {},
   );

   is( $handle->read_handle,  $S1, '->read_handle returns S1' );
   is( $handle->write_handle, $S1, '->write_handle returns S1' );

   is( $handle->notifier_name, "rw=$fd1", '$handle->notifier_name for handle' );
}

# Subclass
my $sub_readready = 0;
my $sub_writeready = 0;

{
   my ( $S1, $S2 ) = mkhandles;

   my $handle = TestHandle->new(
      handle => $S1,
   );

   ok( defined $handle, 'subclass $handle defined' );
   isa_ok( $handle, "IO::Async::Handle", 'subclass $handle isa IO::Async::Handle' );

   is_oneref( $handle, 'subclass $handle has refcount 1 initially' );

   is( $handle->read_handle,  $S1, 'subclass ->read_handle returns S1' );
   is( $handle->write_handle, $S1, 'subclass ->write_handle returns S1' );

   $loop->add( $handle );

   is_refcount( $handle, 2, 'subclass $handle has refcount 2 after adding to Loop' );

   $S2->syswrite( "data\n" );

   wait_for { $sub_readready };

   is( $sub_readready,  1, '$sub_readready while readable' );
   is( $sub_writeready, 0, '$sub_writeready while readable' );

   $S1->getline; # ignore return
   $sub_readready = 0;

   $handle->want_writeready( 1 );

   wait_for { $sub_writeready };

   is( $sub_readready,  0, '$sub_readready while writeable' );
   is( $sub_writeready, 1, '$sub_writeready while writeable' );

   $loop->remove( $handle );
}

# Close
{
   my ( $S1, $S2 ) = mkhandles;

   my $closed = 0;

   my $handle = IO::Async::Handle->new(
      read_handle => $S1,
      want_writeready => 0,
      on_read_ready => sub {},
      on_closed => sub { $closed = 1 },
   );

   $loop->add( $handle );

   my $close_future = $handle->new_close_future;

   my $closed_by_future;
   $close_future->on_done( sub { $closed_by_future++ } );

   $handle->close;

   is( $closed, 1, '$closed after ->close' );

   ok( $close_future->is_ready, '$close_future is now ready' );
   is( $closed_by_future, 1, '$closed_by_future after ->close' );

   # removed itself
}

# Close read/write
{
   my ( $Srd1, $Srd2 ) = mkhandles;
   my ( $Swr1, $Swr2 ) = mkhandles;

   local $SIG{PIPE} = "IGNORE";

   my $readready  = 0;
   my $writeready = 0;

   my $closed = 0;

   my $handle = IO::Async::Handle->new(
      read_handle  => $Srd1,
      write_handle => $Swr1,
      on_read_ready  => sub { $readready++ },
      on_write_ready => sub { $writeready++ },
      on_closed      => sub { $closed++ },
      want_writeready => 1,
   );

   $loop->add( $handle );

   $handle->close_read;

   wait_for { $writeready };
   is( $writeready, 1, '$writeready after ->close_read' );

   $handle->write_handle->syswrite( "Still works\n" );
   is( $Swr2->getline, "Still works\n", 'write handle still works' );

   is( $closed, 0, 'not $closed after ->close_read' );

   is( $handle->loop, $loop, 'Handle still member of Loop after ->close_read' );

   ( $Srd1, $Srd2 ) = mkhandles;

   $handle->configure( read_handle => $Srd1 );

   $handle->close_write;

   $Srd2->syswrite( "Also works\n" );

   wait_for { $readready };
   is( $readready, 1, '$readready after ->close_write' );

   is( $handle->read_handle->getline, "Also works\n", 'read handle still works' );
   is( $Swr2->getline, undef, 'sysread from EOF write handle' );

   is( $handle->loop, $loop, 'Handle still member of Loop after ->close_write' );

   is( $closed, 0, 'not $closed after ->close_read' );

   $handle->close_read;

   is( $closed, 1, '$closed after ->close_read + ->close_write' );

   is( $handle->loop, undef, '$handle no longer member of Loop' );
}

# Late-binding of handle
{
   my $readready;
   my $writeready;

   my $handle = IO::Async::Handle->new(
      want_writeready => 0,
      on_read_ready  => sub { $readready  = 1 },
      on_write_ready => sub { $writeready = 1 },
   );

   ok( defined $handle, '$handle defined' );

   ok( !defined $handle->read_handle,  '->read_handle not defined' );
   ok( !defined $handle->write_handle, '->write_handle not defined' );

   is_oneref( $handle, '$handle latebound has refcount 1 initially' );

   is( $handle->notifier_name, "", '$handle->notifier_name for late bind before handles' );

   $loop->add( $handle );

   is_refcount( $handle, 2, '$handle latebound has refcount 2 after $loop->add' );

   my ( $S1, $S2 ) = mkhandles;
   my $fd1 = $S1->fileno;

   $handle->set_handle( $S1 );

   is( $handle->read_handle,  $S1, '->read_handle now S1' );
   is( $handle->write_handle, $S1, '->write_handle now S1' );

   is_refcount( $handle, 2, '$handle latebound still has refcount 2 after set_handle' );

   is( $handle->notifier_name, "rw=$fd1", '$handle->notifier_name for late bind after handles' );

   $S2->syswrite( "readable" );

   wait_for { $readready };
   pass( '$handle latebound still invokes on_read_ready' );

   $loop->remove( $handle );
}

# ->socket and ->bind
{
   my $handle = IO::Async::Handle->new( on_read_ready => sub {}, on_write_ready => sub {} );

   $handle->socket( [ 'inet', 'stream', 0 ] );

   ok( defined $handle->read_handle, '->socket sets handle' );

   is( $handle->read_handle->sockdomain,       AF_INET,     'handle->sockdomain is AF_INET' );
   is( $handle->read_handle->sockopt(SO_TYPE), SOCK_STREAM, 'handle->socktype is SOCK_STREAM' );

   $handle->bind( { family => "inet", socktype => "dgram" } )->get;

   is( $handle->read_handle->sockopt(SO_TYPE), SOCK_DGRAM, 'handle->socktype is SOCK_DGRAM' );
   # Not sure what port number but it should be nonzero
   ok( ( unpack_sockaddr_in( $handle->read_handle->sockname ) )[0], 'handle->sockname has nonzero port' );
}

# Construction of IO::Handle from fileno
{
   my $handle = IO::Async::Handle->new(
      read_fileno => 0,
      on_read_ready => sub { },
   );

   ok( defined $handle->read_handle, '->new with read_fileno creates read_handle' );
   is( $handle->read_handle->fileno, 0, '->fileno of read_handle' );

   $handle = IO::Async::Handle->new(
      write_fileno => 1,
      on_write_ready => sub { },
   );

   ok( defined $handle->write_handle, '->new with write_fileno creates write_handle' );
   is( $handle->write_handle->fileno, 1, '->fileno of write_handle' );

   $handle = IO::Async::Handle->new(
      read_fileno  => 2,
      write_fileno => 2,
      on_read_ready  => sub { },
      on_write_ready => sub { },
   );

   identical( $handle->read_handle, $handle->write_handle,
      '->new with equal read and write fileno only creates one handle' );
}

done_testing;

package TestHandle;
use base qw( IO::Async::Handle );

sub on_read_ready  { $sub_readready = 1 }
sub on_write_ready { $sub_writeready = 1 }