File Coverage

blib/lib/Test/Mocha.pm

Criterion	Covered	Total	%
statement	136	136	100.0
branch	30	30	100.0
condition	10	12	83.3
subroutine	42	42	100.0
pod	15	17	100.0
total	233	237	99.1

package Test::Mocha;
# ABSTRACT: Test double framework with method stubs and behaviour verification
$Test::Mocha::VERSION = '0.67';

use strict;
use warnings;

use Carp 'croak';
use Exporter 'import';
use Scalar::Util 'blessed';
use Test::Mocha::CalledOk::Times;
use Test::Mocha::CalledOk::AtLeast;
use Test::Mocha::CalledOk::AtMost;
use Test::Mocha::CalledOk::Between;
use Test::Mocha::Mock;
use Test::Mocha::Spy;
use Test::Mocha::Types 'NumRange';
use Test::Mocha::Util 'extract_method_name';
use Types::Standard qw( ArrayRef HashRef Num slurpy );

our @EXPORT = qw(
  mock
  spy
  class_mock
  stub
  returns
  throws
  executes
  called_ok
  times
  atleast
  atmost
  between
  verify
  inspect
  inspect_all
  clear
  SlurpyArray
  SlurpyHash
);

# croak() messages should not trace back to Mocha modules
$Carp::Internal{$_}++ foreach qw(
  Test::Mocha
  Test::Mocha::CalledOk
  Test::Mocha::MethodStub
  Test::Mocha::Mock
  Test::Mocha::Spy
  Test::Mocha::Util
);

sub mock {
    return Test::Mocha::Mock->__new(@_);
}

sub spy ($) {
    return Test::Mocha::Spy->__new(@_);
}

sub stub (&@) {
    my ( $coderef, @responses ) = @_;

    foreach (@responses) {
        croak 'stub() responses should be supplied using ',
          'returns(), throws() or executes()'
          if ref ne 'CODE';
    }

    my @method_calls =
      Test::Mocha::Mock->__capture_method_calls( $coderef, 'stub' );
    for my $method_call (@method_calls) {
        # add stub to mock
        unshift @{ $method_call->invocant->__stubs->{ $method_call->name } },
          $method_call;

        # add response to stub
        Test::Mocha::MethodStub->cast($method_call);
        push @{ $method_call->__responses }, @responses;
    }
    return;
}

sub returns (@) {
    my (@return_values) = @_;
    return sub { $return_values[0] }
      if @return_values == 1;
    return sub { @return_values }
      if @return_values > 1;
    return sub { };  # if @return_values == 0
}

sub throws (@) {
    my (@exception) = @_;

    # check if first arg is a throwable exception
    return sub { $exception[0]->throw }
      if blessed( $exception[0] ) && $exception[0]->can('throw');

    return sub { croak @exception };

}

sub executes (&) {
    my ($callback) = @_;
    return $callback;
}

## no critic (RequireArgUnpacking,ProhibitMagicNumbers)
sub called_ok (&;@) {
    my $coderef = shift;

    my $called_ok;
    my $test_name;
    if ( @_ > 0 && ref $_[0] eq 'CODE' ) {
        $called_ok = shift;
    }
    if ( @_ > 0 ) {
        $test_name = shift;
    }

    my @method_calls =
      Test::Mocha::Mock->__capture_method_calls( $coderef, 'verify' );

    ## no critic (ProhibitAmpersandSigils)
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    $called_ok ||= ×(1);  # default if no times() is specified
    $called_ok->( $_, $test_name ) for @method_calls;
    return;
}
## use critic

## no critic (ProhibitBuiltinHomonyms)
sub times ($) {
    my ($n) = @_;
    croak 'times() must be given a number'
      unless Num->check($n);

    return sub {
        my ( $method_call, $test_name ) = @_;
        Test::Mocha::CalledOk::Times->test( $method_call, $n, $test_name );
    };
}
## use critic

sub atleast ($) {
    my ($n) = @_;
    croak 'atleast() must be given a number'
      unless Num->check($n);

    return sub {
        my ( $method_call, $test_name ) = @_;
        Test::Mocha::CalledOk::AtLeast->test( $method_call, $n, $test_name );
    };
}

sub atmost ($) {
    my ($n) = @_;
    croak 'atmost() must be given a number'
      unless Num->check($n);

    return sub {
        my ( $method_call, $test_name ) = @_;
        Test::Mocha::CalledOk::AtMost->test( $method_call, $n, $test_name );
    };
}

sub between ($$) {
    my ( $lower, $upper ) = @_;
    croak 'between() must be given 2 numbers in ascending order'
      unless NumRange->check( [ $lower, $upper ] );

    return sub {
        my ( $method_call, $test_name ) = @_;
        Test::Mocha::CalledOk::Between->test( $method_call, [ $lower, $upper ],
            $test_name );
    };
}

sub inspect (&) {
    my ($coderef) = @_;
    my @method_calls =
      Test::Mocha::Mock->__capture_method_calls( $coderef, 'inspect' );

    my @inspect;
    foreach my $method_call (@method_calls) {
        push @inspect,
          grep { $method_call->__satisfied_by($_) }
          @{ $method_call->invocant->__calls };
    }
    return @inspect;
}

sub inspect_all ($) {
    my ($mock) = @_;

    croak 'inspect_all() must be given a mock or spy object'
      if !$mock->isa('Test::Mocha::SpyBase');

    return @{ $mock->{calls} };
}

sub clear (@) {
    my @mocks = @_;

    croak 'clear() must be given mock or spy objects'
      if @mocks == 0;
    croak 'clear() accepts mock and spy objects only'
      if 0 < ( grep { !ref $_ || !$_->isa('Test::Mocha::SpyBase') } @mocks );

    @{ $_->__calls } = () foreach @mocks;

    return;
}

## no critic (NamingConventions::Capitalization)
sub SlurpyArray () {
    # uncoverable pod
    return slurpy(ArrayRef);
}

sub SlurpyHash () {
    # uncoverable pod
    return slurpy(HashRef);
}
## use critic

sub class_mock {
    my ($mocked_class) = @_;

    my $module_file = join( q{/}, split q{::}, $mocked_class ) . '.pm';
    my $caller_pkg = caller;
    no strict 'refs';  ## no critic (TestingAndDebugging::ProhibitNoStrict)

    # make sure the real module is not already loaded
    croak "Package '$mocked_class' is already loaded so it cannot be mocked"
      if defined ${ $caller_pkg . '::INC' }{$module_file};

    # check if package has already been mocked
    croak "Package '$mocked_class' is already mocked"
      if defined *{ $mocked_class . '::AUTOLOAD' }{CODE};

    my $mock = mock($mocked_class);

    *{ $mocked_class . '::AUTOLOAD' } = sub {
        my ($method) = extract_method_name( our $AUTOLOAD );
        $mock->$method(@_);
    };
    return $mock;
}

1;

__END__