The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

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

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

# RT #17692 - cannot mock inline package without new()

{ package InlinePackageNoNew; sub foo; }

lives_ok { Test::MockObject::Extends->new( 'InlinePackageNoNew' ) }
	'Mocking a package defined inline should not load anything';

# RT #15446 - isa() ignores type of blessed reference

# fake that Foo is loaded
$INC{'Foo.pm'} = './Foo.pm';

# create object
my $obj = bless {}, "Foo";

# test if the object is a reference to a hash

# silence warnings with UNIVERSAL::isa and Sub::Uplevel
no warnings 'uninitialized';
ok( $obj->isa( 'HASH' ), 'The object isa HASH' );
ok( UNIVERSAL::isa( $obj, 'HASH' ),
	'...also if UNIVERSAL::isa() is called as a function' );

# wrap in mock object
Test::MockObject::Extends->new( $obj );

# test if the mock object is still a reference to a hash
ok( $obj->isa( 'HASH' ), 'The extended object isa HASH' );
ok( UNIVERSAL::isa( $obj, 'HASH' ),
	"...also if UNIVERSAL::isa() is called as a function" );

# RT #14445 - inherited AUTOLOAD does not work correctly

CLASS:
{
	package Foo;

	use vars qw( $called_foo $called_autoload $method_name );

	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 Bar;

	use vars qw( @ISA $called_this );

	BEGIN
	{
		@ISA         = 'Foo';
		$called_this = 0;
	}

	sub this
	{
		$called_this++;
		return 'this';
	}

	1;
}

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

# Create a trvial mocked autoloading object
my $mock = Test::MockObject::Extends->new($object);
isa_ok( $mock, 'Foo' );

# Call foo
is( $mock->foo(),          'foo', 'foo() returns as expected'     );
is( $Foo::called_foo,          1, '$called_foo is incremented'    );
is( $Foo::called_autoload,     0, '$called_autoload is unchanged' );
is( $Foo::method_name,        '', '$method_name is unchanged'     );

# Call an autoloaded method
is( $mock->bar(),          'autoload', 'bad() returns as expected'         );
is( $Foo::called_autoload,          1, '$called_autoload is incremented'   );
is( $Foo::method_name,     'Foo::bar', '$method_name is the correct value' );

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

# Create a non-trivial subclassed autoloading object
$mock = Test::MockObject::Extends->new( $object );
isa_ok( $mock, 'Foo' );
isa_ok( $mock, 'Bar' );

# Call foo
is( $mock->foo(),         'foo', 'foo() returns as expected'     );
is( $Foo::called_foo,         2, '$called_foo is incremented'    );
is( $Foo::called_autoload,    1, '$called_autoload is unchanged' );
is( $Bar::called_this,        0, '$called_this is unchanged'     );

# Call this
is( $mock->this(),         'this', 'this() returns as expected'    );
is( $Foo::called_foo,          2,  '$called_foo is unchanged'      );
is( $Foo::called_autoload,     1,  '$called_autoload is unchanged' );
is( $Bar::called_this,         1,  '$called_this is incremented'   );

# Call an autoloaded method
is( $mock->that(),          'autoload', 'that() returns as expected'      );
is( $Foo::called_autoload,           2, '$called_autoload is incremented' );
is( $Foo::method_name,     'Bar::that', '$method_name is set correctly'   );

### This might demonstrate why the problem happened
is( $Bar::AUTOLOAD, undef,
	"The \$AUTOLOAD for the object's actual class should be unset" );
is( $Foo::AUTOLOAD, 'Bar::that',
    'The $AUTOLOAD that catches the call should contain the desired name'
);

# Get rid of a silly warning
$Bar::AUTOLOAD = $Bar::AUTOLOAD;

package Obj;

sub class_method { 'TRUE-CLASS-METHOD' }

package main;

my $o = Test::MockObject::Extends->new('Obj')->set_always(
	-class_method => 'FAKED RESULT' );
is(  $o->class_method, 'FAKED RESULT', 'class method mocked' );