| Subject: | AUTOLOAD still breaks for non-trivial cases |
Due to an assumption on where to set $AUTOLOAD, the fix for bug #14251 only works in trivial cases where the AUTOLOAD function in is the _actual_ class being mocked.
It fails for situations where the mocked object is of a subclass of the class that actually catches AUTOLOAD, setting the wrong variable, and resulting in an autoload call that still has the $AUTOLOAD from the previous time it was called, resulting in highly unexpected behaviour.
To fix this, we need to know the class where the autoload is caught, and set it's $AUTOLOAD to the value of the method and class we were TRYING to call.
My previous test script only covered the trivial case, and to assist in this situation I've attached a much more comprehensive version that tests behaviour both in the trivial and non-trivial cases.
#!/usr/bin/perl -w
# Regression Test
#
# The Problem:
# When a class implements most of it's functionality via AUTOLOAD,
# and does not have the option of creating specific methods for
# every possible call (for example, there may be infinite possible
# method names) creating a Test::MockObject::Extends with NOTHING
# mocked should result in a "clear" object.
#
# That is, one that behaves as though it doesn't exist. At time of
# writing, Test::MockObject::Extends would fatally break AUTOLOAD,
# resulting in complete loss of functionality.
#
# This script creates such a "clear" extends object, and tests to
# see that AUTOLOAD is still called correctly.
BEGIN
{
chdir 't' if -d 't';
use lib '../lib';
}
use strict;
use Test::More tests => 27;
use Test::Warn;
my $module = 'Test::MockObject::Extends';
use_ok( $module ) or exit;
#####################################################################
# The Test Class
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;
}
#####################################################################
# Testing the Class
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( scalar($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( scalar($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( scalar($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( scalar($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( scalar($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 was correctly NOT set" );
is( $Foo::AUTOLOAD, 'Bar::that', "The \$AUTOLOAD for the class that ACTUALLY catches the call was set to the method we wanted" );
# Get rid of a silly warning
$Bar::AUTOLOAD = $Bar::AUTOLOAD;