| Subject: | Test::MockObject triggers re-entrance bug in UNIVERSAL::isa |
In some situations, it appears that using Test::MockObject changes the
class sufficiently to trigger spurious warnings.
I _suspect_ this is due to the (already filed against
UNIVERSAL::isa|can) re-entrance bug, but that is not an informed
conclusion, just one based on best guess.
I've filed this seperately, because the same case NOT mocked does not
show the problem, so mocking is introducing something extra. Find
attached the proof for this, as a test script. It uses some extra
modules that aren't your deps, so you should either use it for your own
testing, or do some copy paste from those modules and keep the script in
the distribution.
I'll add additional edge cases as I discover them.
This can really be solved in two ways.
Either make it so that Mocking does not trigger the re-entrance (or
whatever the problem actually is) bug, or fix the re-entrance bug in
UNIVERSAL::can|isa and do an incremental release to update the
dependency so the newer version of those get installed.
Unfortunately, this STILL doesn't fix my original problem, but these
last two bugs are obscuring the "real" problem I feel.
| Subject: | edge-cases.t |
#!/usr/bin/perl -w
# Test whether Test::MockObject is sane with several variations of edge cases
use strict;
use File::Spec ();
use Params::Util;
use Class::Inspector;
# Do we have Test::MockObject
use constant TMOE => 'Test::MockObject::Extend';
use constant TMOE_INSTALLED => Class::Inspector->installed(TMOE);
use Test::More;
BEGIN {
TMOE_INSTALLED
? plan( skip_all => 'Test::MockObject::Extends not available' )
: plan( tests => 33 );
}
# Look for warnings as we go, we shouldn't see any
my $problem_count = 0;
local $SIG{__WARN__} = sub { $problem_count += 1 }; # This is so we can
local $SIG{__DIE__} = sub { $problem_count += 10 }; # tell them apart.
sub no_problems () {
is( $problem_count, 0, 'No problems fired' );
}
# Testing an object
sub test_object {
my $foo = shift;
ok( $foo->isa('Foo'), '$foo->isa("Foo") ok' );
no_problems;
ok( Params::Util::_INSTANCE($foo, 'Foo'), '_INSTANCE($foo, "Foo")' );
no_problems;
is( $foo->foo_foo($foo), 'yes', 'An isa inside an assertion in a mocked method ok' );
no_problems;
isa_ok( $foo, 'Foo' );
no_problems;
is( $foo->autoload_foo($foo), 'yes', 'An isa inside an assertion in an AUTOLOAD ok' );
no_problems;
}
#####################################################################
# Main Testing
# Prove the functions work normally
my $foo1 = Foo->new;
test_object( $foo1 );
# Repeat for a transparent subclass
my $bar1 = Foo::Bar->new;
isa_ok( $bar1, 'Foo' );
isa_ok( $bar1, 'Foo::Bar' );
is( $bar1->foo, 'foo', '->foo is ok' );
is( $bar1->bar, 'bar', '->bar is ok' );
test_object( $bar1 );
# Do both of them still work with UNIVERSAL::isa|can loaded
use_ok( 'UNIVERSAL::isa' );
use_ok( 'UNIVERSAL::can' );
my $foo2 = Foo->new;
test_object( $foo2 );
my $bar2 = Foo::Bar->new;
test_object( $bar2 );
# Do both still work when transparently mock-extended
use_ok( 'Test::MockObject::Extends' );
my $foo3 = Test::MockObject::Extends->new( $foo1 );
test_object( $foo3 );
my $bar3 = Test::MockObject::Extends->new( $bar1 );
test_object( $bar3 );
exit(0);
#####################################################################
# The Test Package
package Foo;
sub new {
bless { }, $_[0];
}
# A boring method
sub foo { 'foo' }
# A normally-interesting method
sub foo_foo {
my $self = shift;
if ( Params::Util::_INSTANCE(shift, 'Foo') ) {
return 'yes';
} else {
return 'no';
}
}
sub AUTOLOAD {
my ($method) = $Foo::AUTOLOAD =~ m/^.*::(.*)$/s or return undef;
if ( $method eq 'autoload_foo' ) {
if ( Params::Util::_INSTANCE(shift, 'Foo') ) {
return 'yes';
} else {
return 'no';
}
} else {
die "Tests not meant to be able to get here";
}
}
package Foo::Bar;
use base 'Foo';
use vars qw{$VERSION};
BEGIN {
$VERSION = '0.01';
}
sub bar { 'bar' }
1;