#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 41;
use Test::Exception;

my $module = 'Test::MockObject::Extends';
use_ok( $module ) or exit;

my $tme = $module->new();
isa_ok( $tme, 'Test::MockObject' );

$tme    = $module->new( 'Test::Builder' );
ok( $tme->isa( 'Test::Builder' ),
	'passing a class name to new() should set inheritance properly' );

$tme      = $module->new( 'CGI' );
ok( $INC{'CGI.pm'},
	'new() should load parent module unless already loaded' );

package Some::Class;

@Some::Class::ISA = 'Another::Class';

sub path
{
	return $_[0]->{path};
}

sub foo
{
	return 'original';
}

sub bar
{
	return 'original';
}

package Another::Class;

package main;

# fake that we have loaded these
$INC{'Some/Class.pm'}    = 1;
$INC{'Another/Class.pm'} = 1;

$tme       = $module->new( 'Some::Class' );
my $result = $tme->set_always( bar => 'mocked' );
is( $tme->bar(), 'mocked',   'mock() should override method in parent' );
is( $tme->foo(), 'original', '... calling original methods in parent'  );
is( $result,           $tme, '... returning invocant'                  );

$result = $tme->unmock( 'bar' );
is( $tme->bar(), 'original', 'unmock() should remove method overriding' );
is( $result,           $tme, '... returning invocant'                   );

$result = $tme->mock( pass_self => sub
{
	is( shift,   $tme, '... and should pass along invocant' );
	is( $result, $tme, '... returning invocant'             );
});

$tme->pass_self();
my ($method, $args) = $tme->next_call();
is( $method, 'bar', '... logging methods appropriately' );

my $sc      = bless { path => 'my path' }, 'Some::Class';
my $mock_sc = $module->new( $sc );
is( $mock_sc->path(), 'my path',
	'... should wrap existing object appropriately' );
isa_ok( $mock_sc, 'Some::Class' )
	or diag( '... marking isa() appropriately on mocked object' );
isa_ok( $mock_sc, 'Another::Class' )
	or diag( '... and delegating isa() appropriately on parent classes' );

ok( ! $mock_sc->isa( 'No::Class' ),
	'... returning the right result even when the class is not a parent' );

$tme->set_always( -foo => 11 );
is( $tme->foo(), 11, 'unlogged methods should work' );
ok( ! $tme->called( 'foo' ), '... and logging should not happen for them' );

{
	my $warnings         = '';
	local $SIG{__WARN__} = sub { $warnings .= shift };
	$tme->set_always( foo => 12 );
	is( $warnings, '', '... not throwing redefinition warnings' );
}

$tme->set_always( foo => 12 );
is( $tme->foo(), 12,         '... allowing overriding with logged versions' );
ok( $tme->called( 'foo' ),   '... with logging happening then, obviously'   );

package Parent;

$INC{'Parent.pm'} = 1;

use vars '$somethingnasty';
$somethingnasty = '';

sub new      { bless {}, $_[0] }

sub mockthis { $somethingnasty = 1 }

sub AUTOLOAD { return $_[0]->mockthis() }

package main;

my $parent = Parent->new();
my $extend = Test::MockObject::Extends->new( $parent );
$extend->mock( 'mockthis', sub { return 'foo' } );
is( $extend->foo(), 'foo', 'Mocking worked' );
ok( ! $Parent::somethingnasty, "Method didn't trigger bad method" );

package Foo;

@Foo::ISA = 'Parent';

my ($called_foo, $called_autoload, $method_name);

use vars '$AUTOLOAD';

BEGIN
{
	$called_foo      = 0;
	$called_autoload = 0;
	$method_name     = '';
}

sub new
{
	bless {}, $_[0];
}

sub foo
{
	$called_foo++;
	return 'foo';
}

sub AUTOLOAD
{
	$called_autoload++;
	$method_name = $Foo::AUTOLOAD;
	return 'autoload';
}

package main;

my $object = Foo->new();
isa_ok( $object, 'Foo' );

my $mock;
lives_ok { $mock = Test::MockObject::Extends->new( $object ) }
	'Creating a wrapped module should not die';
isa_ok( $mock, 'Foo'   );

# Call foo()
is( $mock->foo(),     'foo', 'foo() should return as expected' );
is( $called_foo,          1, '... calling the method'          );
is( $called_autoload,     0, '... not touching AUTOLOAD()'     );
is( $Foo::AUTOLOAD,   undef, '... or $Foo::AUTOLOAD'           );

# Call an autoloaded method
is( $mock->bar(),     'autoload', 'bad() should returns as expected'        );
is( $called_autoload,          1, '... calling AUTOLOAD()'                  );
is( $method_name,     'Foo::bar', '... with the appropriate $Foo::AUTOLOAD' );

# get the parents of the mocked object (to work with SUPER)
$result = [ $mock->__get_parents() ];
is_deeply( $result, [qw( Parent )],
	'__get_parents() should return a list of parents of the wrapped object' );


package FooNoAutoload;

my ($called_fooNA, $called_autoloadNA, $method_nameNA);

sub new
{
	bless {}, $_[0];
}

sub fooNA
{
	$called_fooNA++;
	return 'fooNA';
}

package main;

BEGIN
{
	$called_fooNA      = 0;
	$called_autoloadNA = 0;
	$method_nameNA     = '';
}

$object = FooNoAutoload->new();
isa_ok( $object, 'FooNoAutoload' );

undef $mock;
lives_ok { $mock = Test::MockObject::Extends->new( $object ) }
	'Creating a wrapped module should not die';
isa_ok( $mock, 'FooNoAutoload'   ); #37

# Call foo()
is( $mock->fooNA(),     'fooNA', 'fooNA() should return as expected' );
is( $called_fooNA,          1, '... calling the method'          );
is( $called_autoloadNA,     0, '... not touching AUTOLOAD()'     );

# Call a non-existent method
dies_ok (sub{ $mock->bar()},     
    '... should die if calling a non-mocked and non-AUTOLOADED method' );