File Coverage

blib/lib/Test/ExpectAndCheck/Future.pm

Criterion	Covered	Total	%
statement	58	64	90.6
branch	12	14	85.7
condition	4	6	66.6
subroutine	16	18	88.8
pod			n/a
total	90	102	88.2

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2020 -- [e-mail]

package Test::ExpectAndCheck::Future;

use strict;
use warnings;
use base qw( Test::ExpectAndCheck );

our $VERSION = '0.05';

use constant EXPECTATION_CLASS => "Test::ExpectAndCheck::Future::_Expectation";

=head1 NAME

C - C-style unit testing with C-returning methods

=head1 SYNOPSIS

   use Test::More;
   use Test::ExpectAndCheck::Future;

   use Future::AsyncAwait;

   my ( $controller, $mock ) = Test::ExpectAndCheck::Future->create;

   {
      $controller->expect( act => 123, 45 )
         ->will_done( 678 );

      is( await $mock->act( 123, 45 ), 678, '$mock->act yields result' );

      $controller->check_and_clear( '->act' );
   }

   done_testing;

=head1 DESCRIPTION

This package creates objects that assist in writing unit tests with mocked
object instances. Each mocked instance will expect to receive a given list of
method calls. Each method call is checked that it received the right
arguments, and will return a L instance to yield the prescribed
result. At the end of each test, each object is checked to ensure all the
expected methods were called.

It is a variation of L, assistance around the results
of invoked methods. Every invoked method will return a L instance. The
L or L method can then set the desired eventual result
of that future instance for each expectation.

These return instances are implemented using L, so
they are not immediately ready. Instead they will only become ready after a
toplevel C expression or call to the C method. This should help
unit tests to run similarly to real-world behaviour, where most futures
returned by real-world interfaces (such as IO systems) would not be
immediately ready. This behaviour can be switched off for individual
expectations by using the L method.

=cut

package
   Test::ExpectAndCheck::Future::_Expectation;
use base qw( Test::ExpectAndCheck::_Expectation );

use Test::Future::Deferred;

use Carp;
our @CARP_NOT = qw( Test::ExpectAndCheck );

use constant {
   BEHAVE_NOFUTURE => 0,
   BEHAVE_DONE     => 1,
   BEHAVE_FAIL     => 2,
   BEHAVE_PENDING  => 3,
   BEHAVE_IMM_MASK => 4,
};

=head1 EXPECTATIONS

=cut

=head2 will_done

   $exp->will_done( @result );

I

Sets that method call will return a C instance which will succeed
with the given result.

=cut

sub will_done
{
   my $self = shift;

   my $imm = ( $self->{behaviour}[0] // 0 ) & BEHAVE_IMM_MASK;
   $self->{behaviour} = [ BEHAVE_DONE|$imm, @_ ];

   return $self;
}

# This was a bad API; "returns" on a T:EAC:Future expectation would set the
# future done result, not the immediate method call result
sub returns
{
   warnings::warnif deprecated => "Calling \$exp->returns() on a Future expectation is now deprecated; use ->will_done instead";
   return shift->will_done( @_ );
}

=head2 will_fail

   $exp->will_fail( $message, $category, @more );

I

Sets that method call will return a C instance which will fail
with the given message, and optionally category name and extra details.

=cut

sub will_fail
{
   my $self = shift;

   my $imm = ( $self->{behaviour}[0] // 0 ) & BEHAVE_IMM_MASK;
   $self->{behaviour} = [ BEHAVE_FAIL|$imm, @_ ];

   return $self;
}

sub fails
{
   warnings::warnif deprecated => "Calling \$exp->fails() is now deprecated; use ->will_fail instead";
   return shift->will_fail( @_ );
}

# Reset the future-type behaviour on these
sub will_return_using
{
   my $self = shift;

   $self->SUPER::will_return_using( @_ );
   $self->{behaviour} = [ BEHAVE_NOFUTURE ];

   return $self;
}

=head2 immediately

   $exp->will_done( ... )->immediately;

   $exp->will_fail( ... )->immediately;

I

Switches this expectation to return an immediate future, rather than a
deferred one.

=cut

sub immediately
{
   my $self = shift;

   $self->{behaviour}[0] |= BEHAVE_IMM_MASK;

   return $self;
}

=head2 remains_pending

   $exp->remains_pending;

I

Sets that the future returned by this method will not complete and simply
remain pending.

=cut

sub remains_pending
{
   my $self = shift;

   $self->{behaviour}[0] = BEHAVE_PENDING;

   return $self;
}

=head2 will_also_later

   $exp->will_also_later( sub { ... } );

I

Adds extra code which will run when the expected method is called, after the
returned future has completed. This is performed by the use of
C.

When invoked, the code body is invoked in void context with no additional
arguments.

=cut

sub will_also_later
{
   my $self = shift;

   push @{ $self->{also_later} }, @_;

   return $self;
}

sub _result
{
   my $self = shift;

   my $behaviour = $self->{behaviour} // [ 0 ];
   my ( $type, @args ) = @$behaviour;

   # $type == BEHAVE_NOFUTURE is zero and ignored
   if( $type == BEHAVE_DONE ) {
      $self->SUPER::will_return( Test::Future::Deferred->done_later( @args ) );
   }
   elsif( $type == (BEHAVE_DONE|BEHAVE_IMM_MASK) ) {
      $self->SUPER::will_return( Future->done( @args ) );
   }
   elsif( $type == BEHAVE_FAIL ) {
      $self->SUPER::will_return( Test::Future::Deferred->fail_later( @args ) );
   }
   elsif( $type == (BEHAVE_FAIL|BEHAVE_IMM_MASK) ) {
      $self->SUPER::will_return( Future->fail( @args ) );
   }
   elsif( $type == BEHAVE_PENDING ) {
      $self->SUPER::will_return( Future->new );
   }
   elsif( $type ) {
      die "TODO: Need result type $type";
   }

   if( my $also_later = $self->{also_later} ) {
      Test::Future::Deferred->done_later
         ->on_done( sub { $_->() for @$also_later } )
         ->retain;
   }

   return $self->SUPER::_result( @_ );
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;