Mocking Classes and Test::Class

jmcada has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks! I'm working with Test::Class and have ran into an issue where mocked objects and classes prevent the real modules from being loaded in subsequent test classes. Currently, our test driver is a script that searches for all test classes, loads them, and runs Test::Class->runtests. I'm sure that we could work with the script and have it load a single test class at a time or something fancy like that; however, I was trying to avoid it. Instead, we have been trying to monkey around with the symbol table to force the modules to reload. Is there a way to make this work? (Here is my contrived example)

package X;

use base qw(Test::Class);
use Test::More;
use Test::MockClass;

sub setup : Test(setup) {
  my ($self) = @_;
  my $mockClass = Test::MockClass->new('DateTime');
  $mockClass->addMethod('now', sub {'XXXX'});
}

sub test : Test {
  my ($self) = @_;
  ok(DateTime->now);
  diag(DateTime->now);
}

1;

package Y;

use base qw(Test::Class);
use Test::More;
use DateTime;

sub test : Test {
  my ($self) = @_;
  ok(DateTime->now);
  diag(DateTime->now);
}

1;

package Z;

use Test::Class;

Test::Class->runtests;

1;
[download]

Comment on Mocking Classes and Test::Class Select or Download Code

Replies are listed 'Best First'.
Re: Mocking Classes and Test::Class by xdg (Monsignor) on Mar 14, 2006 at 17:02 UTC
Tricky. A couple ideas (untested): 1. Delete `$INC{$filename}` (where `$filename` is the conversion of a bare module name to a filename) and then re-`require` the module to re-load it. (You may need to silence `redefine` warnings.) See require for details. 2. Require the real module and mock an empty subclass instead. (Though you might wind up with un-mocked behavior if you call a non-mocked, inherited method. `sub setup : Test(setup) { my ($self) = @_; my $mockClass = Test::MockClass->new('Mock::DateTime'); $mockClass->addMethod('now', sub {'XXXX'}); require DateTime; @Mock::DateTime::ISA = qw( DateTime ); } sub test : Test { my ($self) = @_; ok(Mock::DateTime->now); diag(Mock::DateTime->now); }` [download] -xdg Code written by xdg and posted on PerlMonks is public domain. It is provided as is with no warranties, express or implied, of any kind. Posted code may not have been tested. Use of posted code is at your own risk.	[reply] [d/l] [select]
Re: Mocking Classes and Test::Class by adrianh (Chancellor) on Mar 15, 2006 at 11:59 UTC
Is there a way to make this work? I find that mucking around with the symbol table like this with persistent test environments is just more trouble than it's worth. Maybe try using Hook::LexWrap instead? use strict; use warnings; { package X; use base qw(Test::Class); use Test::More; use DateTime; use Hook::LexWrap; sub setup_test_double : Test( startup ) { my ( $self ) = @_; # we stick our Hook::LexWrap object in $self so it'll # magically go out of scope after this test class has # run, so get garbage collected, so return DateTime to # its pristine state $self->{ test_double } = wrap 'DateTime::now', pre => sub { $_[-1] = 'XXXX' }; } sub use_test_double : Test { my ( $self ) = @_; is( DateTime->now, 'XXXX' ); } } { package Y; use base qw(Test::Class); use Test::More; use DateTime; sub using_real_class : Test { my ( $self ) = @_; isa_ok( DateTime->now, 'DateTime' ); } } Test::Class->runtests; [download]	[reply] [d/l]