view release on metacpan or  search on metacpan

local/lib/perl5/IO/Async/LoopTests.pm  view on Meta::CPAN

      $Prd->close;

      $loop->loop_once( 0.1 );

      is( $hangup, 1, '$hangup after pipe close for writing' );

      $loop->unwatch_io(
         handle => $Pwr,
         on_hangup => 1,
      );
   }

   # Check that combined read/write handlers can cancel each other
   {
      my ( $S1, $S2 ) = IO::Async::OS->socketpair or die "Cannot socketpair - $!";
      $_->blocking( 0 ) for $S1, $S2;

      my $callcount = 0;
      $loop->watch_io(
         handle => $S1,
         on_read_ready => sub {
            $callcount++;
            $loop->unwatch_io( handle => $S1, on_read_ready => 1, on_write_ready => 1 );
         },
         on_write_ready => sub {
            $callcount++;
            $loop->unwatch_io( handle => $S1, on_read_ready => 1, on_write_ready => 1 );
         },
      );

      $S2->close;

      $loop->loop_once( 0.1 );

      is( $callcount, 1, 'read/write_ready can cancel each other' );
   }

   # Check that cross-connected handlers can cancel each other
   {
      my ( $SA1, $SA2 ) = IO::Async::OS->socketpair or die "Cannot socketpair - $!";
      my ( $SB1, $SB2 ) = IO::Async::OS->socketpair or die "Cannot socketpair - $!";
      $_->blocking( 0 ) for $SA1, $SA2, $SB1, $SB2;

      my @handles = ( $SA1, $SB1 );

      my $callcount = 0;
      $loop->watch_io(
         handle => $_,
         on_write_ready => sub {
            $callcount++;
            $loop->unwatch_io( handle => $_, on_write_ready => 1 ) for @handles;
         },
      ) for @handles;

      $loop->loop_once( 0.1 );

      is( $callcount, 1, 'write_ready on crosslinked handles can cancel each other' );
   }

   # Check that error conditions that aren't true read/write-ability are still
   # invoked
   {
      my ( $S1, $S2 ) = IO::Async::OS->socketpair( 'inet', 'dgram' ) or die "Cannot create AF_INET/SOCK_DGRAM connected pair - $!";
      $_->blocking( 0 ) for $S1, $S2;
      $S2->close;

      my $readready = 0;
      $loop->watch_io(
         handle => $S1,
         on_read_ready => sub { $readready = 1 },
      );

      $S1->syswrite( "Boo!" );

      $loop->loop_once( 0.1 );

      is( $readready, 1, 'exceptional socket invokes on_read_ready' );

      $loop->unwatch_io(
         handle => $S1,
         on_read_ready => 1,
      );
   }

   # Check that regular files still report read/writereadiness
   {
      my $F = IO::File->new_tmpfile or die "Cannot create temporary file - $!";

      $F->print( "Here's some content\n" );
      $F->seek( 0, SEEK_SET );

      my $readready  = 0;
      my $writeready = 0;
      $loop->watch_io(
         handle => $F,
         on_read_ready  => sub { $readready = 1 },
         on_write_ready => sub { $writeready = 1 },
      );

      $loop->loop_once( 0.1 );

      is( $readready,  1, 'regular file is readready' );
      is( $writeready, 1, 'regular file is writeready' );

      $loop->unwatch_io(
         handle => $F,
         on_read_ready  => 1,
         on_write_ready => 1,
      );
   }
}

=head2 timer

Tests the Loop's ability to handle timer events

=cut

use constant count_tests_timer => 21;
sub run_tests_timer