#  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-2022 -- leonerd@leonerd.org.uk

package Test::Future::IO;

use strict;
use warnings;

our $VERSION = '0.04';

use Carp;

use Test::ExpectAndCheck::Future 0.04;  # ->will_* API
use Test::Deep ();

=head1 NAME

C<Test::Future::IO> - unit testing on C<Future::IO>

=head1 SYNOPSIS

   use Test::More;
   use Test::Future::IO;

   my $controller = Test::Future::IO->controller;

   {
      $controller->expect_syswrite( "Hello, world\n" );
      $controller->expect_sysread( 256 )
         ->will_done( "A string\n");

      code_under_test();

      $controller->check_and_clear( 'code under test did correct IO' );
   }

=head1 DESCRIPTION

This package provides a means to apply unit testing around code which uses
L<Future::IO>. It operates in an "expect-and-check" style of mocking,
requiring the test script to declare upfront what methods are expected to be
called, and what values they return.

=cut

=head1 EXPECTATIONS

Each of the actual C<Future::IO> methods has a corresponding expectation
method on the controller object, whose name is prefixed with C<expect_>. A
single call to one of these methods by the unit test script represents a
single call to a C<Future::IO> method that the code under test is expected to
make. The arguments to the expectation method should match those given by the
code under test. Each expectation method returns an object which has
additional methods to control the behaviour of that invocation.

   $exp = $controller->expect_sleep( $secs );

   $exp = $controller->expect_sysread( $fh, $len );
   $exp = $controller->expect_syswrite( $fh, $bytes );

   $exp = $controller->expect_sysread_anyfh( $len );
   $exp = $controller->expect_syswrite_anyfh( $bytes );

The returned expectation object allows the test script to specify what such an
invocation should return.

   $exp->will_done( @result );

Expectations can make methods fail instead.

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

Expectations can be set to remain pending rather than completing.

   $exp->remains_pending;

As a convenience, a C<syswrite> expectation will default to returning a future
that will complete yielding its length (as is usual for successful writes),
and a C<sleep> expectation will return a future that completes yielding
nothing.

=cut

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

require Future::IO;
Future::IO->override_impl( $obj );

sub expect_sleep
{
   my $self = shift;
   my ( $secs ) = @_;

   return $controller->expect( sleep => $secs )
      ->will_done();
}

sub expect_sysread
{
   my $self = shift;
   my ( $fh, $len ) = @_;
   if( @_ == 1 ) {
      carp "->expect_sysread with one argument is now deprecated";
      ( $fh, $len ) = ( Test::Deep::ignore(), @_ );
   }

   return $controller->expect( sysread => $fh, $len );
}

sub expect_syswrite
{
   my $self = shift;
   my ( $fh, $bytes ) = @_;
   if( @_ == 1 ) {
      carp "->expect_syswrite with one argument is now deprecated";
      ( $fh, $bytes ) = ( Test::Deep::ignore(), @_ );
   }

   return $controller->expect( syswrite => $fh, $bytes )
      ->will_done( length $bytes );
}

sub expect_sysread_anyfh
{
   my $self = shift;
   $self->expect_sysread( Test::Deep::ignore() => @_ );
}

sub expect_syswrite_anyfh
{
   my $self = shift;
   $self->expect_syswrite( Test::Deep::ignore() => @_ );
}

=head1 METHODS

=cut

=head2 controller

   $controller = Test::Future::IO->controller;

Returns the control object, on which the various C<expect_*> methods and
C<check_and_clear> can be invoked.

=cut

sub controller { __PACKAGE__ }

=head2 check_and_clear

   $controller->check_and_clear( $name );

Checks that by now, every expected method has been called, and emits a new
test output line via L<Test::Builder>. Regardless, the expectations are also
cleared out ready for the start of the next test.

=cut

sub check_and_clear
{
   shift;
   my ( $name ) = @_;

   local $Test::Builder::Level = $Test::Builder::Level + 1;
   $controller->check_and_clear( $name );
}

=head1 TODO

=over 4

=item *

Configurable matching on filehandles. Provision of a mock filehandle object to
assist unit tests.

=back

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;
