view release on metacpan or  search on metacpan

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

      # poll might have returned just a little early, such that the TimerQueue
      # doesn't think anything is ready yet. We need to handle that case.
      while( !$done ) {
         die "It should have been ready by now" if( time - $now > 5 * AUT );
         $loop->loop_once( 0.1 * AUT );
      }
   } 1.5, 2.5, 'requeued timer of delay 2';

   is( $done, 2, '$done is 2 after requeued timer' );
}

=head2 signal

Tests the Loop's ability to watch POSIX signals

=cut

use constant count_tests_signal => 14;
sub run_tests_signal
{
   unless( IO::Async::OS->HAVE_SIGNALS ) {
      SKIP: { skip "This OS does not have signals", 14; }
      return;
   }

   my $caught = 0;

   $loop->watch_signal( TERM => sub { $caught++ } );

   is_oneref( $loop, '$loop has refcount 1 after watch_signal' );

   $loop->loop_once( 0.1 );

   is( $caught, 0, '$caught idling' );

   kill SIGTERM, $$;

   is( $caught, 0, '$caught before ->loop_once' );

   $loop->loop_once( 0.1 );

   is( $caught, 1, '$caught after ->loop_once' );

   kill SIGTERM, $$;

   is( $caught, 1, 'second raise is still deferred' );

   $loop->loop_once( 0.1 );

   is( $caught, 2, '$caught after second ->loop_once' );

   is_oneref( $loop, '$loop has refcount 1 before unwatch_signal' );

   $loop->unwatch_signal( 'TERM' );

   is_oneref( $loop, '$loop has refcount 1 after unwatch_signal' );

   my ( $cA, $cB );

   my $idA = $loop->attach_signal( TERM => sub { $cA = 1 } );
   my $idB = $loop->attach_signal( TERM => sub { $cB = 1 } );

   is_oneref( $loop, '$loop has refcount 1 after 2 * attach_signal' );

   kill SIGTERM, $$;

   $loop->loop_once( 0.1 );

   is( $cA, 1, '$cA after raise' );
   is( $cB, 1, '$cB after raise' );

   $loop->detach_signal( 'TERM', $idA );

   undef $cA;
   undef $cB;

   kill SIGTERM, $$;

   $loop->loop_once( 0.1 );

   is( $cA, undef, '$cA after raise' );
   is( $cB, 1,     '$cB after raise' );

   $loop->detach_signal( 'TERM', $idB );

   ok( exception { $loop->attach_signal( 'this signal name does not exist', sub {} ) },
       'Bad signal name fails' );
}

=head2 idle

Tests the Loop's support for idle handlers

=cut

use constant count_tests_idle => 11;
sub run_tests_idle
{
   my $called = 0;

   my $id = $loop->watch_idle( when => 'later', code => sub { $called = 1 } );

   ok( defined $id, 'idle watcher id is defined' );

   is( $called, 0, 'deferred sub not yet invoked' );

   time_between { $loop->loop_once( 3 * AUT ) } undef, 1.0, 'loop_once(3) with deferred sub';

   is( $called, 1, 'deferred sub called after loop_once' );

   $loop->watch_idle( when => 'later', code => sub {
      $loop->watch_idle( when => 'later', code => sub { $called = 2 } )
   } );

   $loop->loop_once( 1 );

   is( $called, 1, 'inner deferral not yet invoked' );

   $loop->loop_once( 1 );

   is( $called, 2, 'inner deferral now invoked' );

   $called = 2; # set it anyway in case previous test fails

   $id = $loop->watch_idle( when => 'later', code => sub { $called = 20 } );

   $loop->unwatch_idle( $id );

   time_between { $loop->loop_once( 1 * AUT ) } 0.5, 1.5, 'loop_once(1) with unwatched deferral';

   is( $called, 2, 'unwatched deferral not called' );

   $id = $loop->watch_idle( when => 'later', code => sub { $called = 3 } );
   my $timer_id = $loop->watch_time( after => 5, code => sub {} );

   $loop->loop_once( 1 );

   is( $called, 3, '$loop->later still invoked with enqueued timer' );

   $loop->unwatch_time( $timer_id );

   $loop->later( sub { $called = 4 } );

   $loop->loop_once( 1 );

   is( $called, 4, '$loop->later shortcut works' );