#!/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 }