#! perl

use strict;
use warnings;

use Test::More tests => 18;
use Test::MockObject;

use Scalar::Util 'weaken';

{
	my $mock = Test::MockObject->new();

	local $@ = '';
	eval { $mock->called( 1, 'foo' ) };
	is( $@, '', 'called() should not die from no array ref object' );
}

{
	my $mock = Test::MockObject->new();

	$mock->{_calls} = [ 1 .. 4 ];
	$mock->_call( 5 );
	is( @{ $mock->{_calls} }, 4,
		'_call() should not autovivify extra calls on the stack' );
}

{
	my $mock = Test::MockObject->new();
	my $warn = '';
	local $SIG{__WARN__} = sub {
		$warn = shift;
	};
	$mock->fake_module( 'Foo', bar => sub {} );
	$mock->fake_module( 'Foo', bar => sub {} );
	is( $warn, '', 'fake_module() should catch redefined sub warnings' );
}

{
	my ($ok, $warn, @diag) = ('') x 2;
	{
		local (*Test::Builder::ok, *Test::Builder::diag);
		*Test::Builder::ok = sub {
			$ok = $_[1];
		};

		*Test::Builder::diag = sub {
			push @diag, $_[1];
		};

		my $mock = Test::MockObject->new();
		$mock->{_calls} = [ [ 4, 4 ], [ 5, 5 ] ];

		$mock->called_pos_ok( 2, 8 );

		local $SIG{__WARN__} = sub {
			$warn = shift;
		};

		$mock->called_pos_ok( 888, 'foo' );
	}

	ok( ! $ok, 'called_pos_ok() should return false if name does not match' );
	like( $diag[0], qr/Got.+Expected/s, '... printing a helpful diagnostic' );
	unlike( $warn, qr/uninitialized value/,
		'called_pos_ok() should throw no uninitialized warnings on failure');
	like( $diag[1], qr/'undef'/, '... faking it with the word in the error' );
}

{
	my $mock = Test::MockObject->new();
	$mock->set_true( 'foo' );
	$_ = 'bar';
	$mock->foo( $1 ) if /(\w+)/;
	is( $mock->call_args_pos( -1, 2 ), 'bar', 
		'$1 should be preserved through AUTOLOAD invocation' );
}

{
	my $mock = Test::MockObject->new();
	$mock->fake_module( 'fakemodule' );
	no strict 'refs';
	ok( %{ 'fakemodule::' },
		'fake_module() should create a symbol table entry for the module' );
}

# respect list context at the end of a series
{
	my $mock = Test::MockObject->new();
	$mock->set_series( count => 2, 3 );
	my $i;
	while (my ($count) = $mock->count())
	{
		$i++;
		last if $i > 2;
	}

	is( $i, 2, 'set_series() should return false at the end of a series' );
}

# Jay Bonci discovered false positives in called_ok() in 0.11
{
	local *Test::Builder::ok;
	*Test::Builder::ok = sub {
		$_[1];
	};

	my $new_mock = Test::MockObject->new();
	my $result   = $new_mock->called_ok( 'foo' );

	is( $result, 0, 'called_ok() should not report false positives' );
}

package Override;

my $id = 'default';

use base 'Test::MockObject';
use overload '""' => sub { return $id };

package main;

my $o = Override->new();
$o->set_always( foo => 'foo' );

is( "$o", 'default',  'default overloadings should work' );
$id = 'my id';
is( "$o", 'my id',    '... and not be static' );
is( $o->foo(), 'foo', '... but should not interfere with method finding' );

# no overload '""';

# David Pisoni found memory leak condition
{
	# Setup MOs with 2 references
	my ($obj1, $obj2, $obj1prime, $obj2prime);
	$obj1 = $obj1prime = Test::MockObject->new();
	$obj2 = $obj2prime = Test::MockObject->new();

	# Weaken one of the references each
	weaken $obj1prime;
	weaken $obj2prime;

	# test for memory leak condition
	$obj1->set_true('this');
	$obj1->this($obj2);

	undef $obj2;

	is( ref($obj2prime), 'Test::MockObject',
		'MO cached by another MO log should not be garbage collected' );
	undef $obj1;

	ok( !ref($obj2prime), '... but should go away when caching MO does' );

	ok( !ref($obj1prime),
		'... and the caching MO better go away too!' );
}

# Mutant reported RT #21049 - lack of new() in fake_module() may be a problem
{
	my $mock = Test::MockObject->new();
	local $@;

	$INC{'Some/Module.pm'} = 1;
	eval { $mock->fake_module( 'Some::Module' ) };
	like( $@, qr/No mocked subs for loaded module 'Some::Module'/,
		'fake_module() should throw exception for loaded module without mocks');
}

# Adam Kennedy reported RT #19448 - typo in check_class_loaded()
{
	my $mock = Test::MockObject->new();

	package Foo::Bar;

	sub foo {}

	package main;

	ok( $mock->check_class_loaded( 'Foo::Bar' ),
		'check_class_loaded() should work for nested class names' );
}