#!/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' );