view release on metacpan or  search on metacpan

lib/Class/Mock/Method/InterfaceTester.pm  view on Meta::CPAN

package Class::Mock::Method::InterfaceTester;

use strict;
use warnings;

our $VERSION = '1.3002';

# all this pre-amble is damned near identical to C::M::G::IT. Re-factor.
use Test::More ();
use Data::Compare;
use Scalar::Util qw(blessed);
use PadWalker qw(closed_over);
use Data::Dumper::Concise;

use Class::Mock::Common ();

use Class::Mockable
    _ok => sub { Test::More::ok($_[0], @_[1..$#_]) };

use constant {
    DIDNT_RUN_ALL             => 'didn\'t run all tests in mock method defined in %s (remaining tests: %s)',
    RUN_OUT                   => 'run out of tests on mock method defined in %s',

    WRONG_ARGS                => 'wrong args to mock method defined in %s. Got %s',
    WRONG_ARGS_W_EXPECTED     => 'wrong args to mock method defined in %s. Got %s, expected %s',

    BOTH_INVOCANTS            => 'bad fixture %s, can\'t have invocant_object and invocant_class, defined in %s',
    EXP_CLASS_GOT_OBJECT      => 'expected call as class method, but object method called, defined in %s',
    EXP_OBJECT_GOT_CLASS      => 'expected call as object method, but class method called, defined in %s',
    WRONG_CLASS               => 'class method called on wrong class, defined in %s - got %s expected %s',
    WRONG_OBJECT              => 'object method called on object of wrong class, defined in %s - called on a %s, expected a %s',
    WRONG_OBJECT_SUBREF       => 'object method called on object which doesn\'t match specified sub-ref, defined in %s',
};

sub new {
    my $class = shift;
    my $called_from = (caller(1))[3];

    my $tests = shift;
    my @tests;
    if(ref($tests) eq 'ARRAY') { @tests = @{$tests}; }
     else { @tests = Class::Mock::Common::_get_tests_from_file(${$tests});
    }

    return bless(sub {
        if(!@tests) { # no tests left
            return $class->_report_error(RUN_OUT, $called_from);
        }

        my $this_test = shift(@tests);
        my $invocant = shift;
        my @params = @_;

        # check arguments
        if(ref($this_test->{input}) eq 'CODE') {
            if(!$this_test->{input}->(@params)) {
                return $class->_report_error(WRONG_ARGS, $called_from, Dumper(\@params));
            }
        } elsif(!Compare($this_test->{input}, \@params)) {
                return $class->_report_error(WRONG_ARGS_W_EXPECTED, $called_from, Dumper(\@params), Dumper($this_test->{input}));
        }

        # check invocant
        if($this_test->{invocant_class} && $this_test->{invocant_object}) {
            return $class->_report_error(BOTH_INVOCANTS, Dumper($this_test), $called_from);
        } elsif($this_test->{invocant_class}) { # must be called as class method on right class
            if(ref($invocant)) {
                return $class->_report_error(EXP_CLASS_GOT_OBJECT, $called_from);
            } elsif($invocant ne $this_test->{invocant_class}) {
                return $class->_report_error(WRONG_CLASS, $called_from, $invocant, $this_test->{invocant_class});
            }
        } elsif($this_test->{invocant_object}) { # must be called as object method