I'm using MockObjects in some of my tests and just had to test a function with a call to a SUPER class and I cannot seem to make it work. Can UNIVERSAL calls like $this->SUPER::save() not be mocked? If yes, how do you do it?
Thanks.
Edit:
Found it!
Use fake_module from Test::MockObject
So, let's say your base module it Some::Module, and your subroutine is making a $this->SUPER::save call, use
my $child_class_mockup = Test::MockObject->new();
$child_class_mockup->fake_module(
'Some::Module',
save => sub () { return 1; }
);
Leaving the question open for a couple of days, to get inputs about different ways/libraries of doing this (what if, the SUPER call had a SUPER call?) before accepting this answer.
Find out the name of the object's superclass (or one of the superclasses, since Perl has multiple inheritance), and define the save call in the superclass's package.
For example, if you have
package MyClass;
use YourClass;
our #ISA = qw(YourClass); # <-- name of superclass
...
sub foo {
my $self = shift;
...
$self->SUPER::save(); # <--- want to mock this function in the test
...
}
sub save {
# MyClass version of save method
...
}
then in your test script, you would say
no warnings 'redefine'; # optional, suppresses warning
sub YourClass::save {
# mock function for $yourClassObj->save, but also
# a mock function for $myClassObj->SUPER::save
...
}
Related
I have noticed some Perl modules use a class based structure, but don't manage any data. The class is simply used to access the methods within and nothing more.
Consider the following example:
Class.pm
package Class;
use Moose;
sub do_something {
print "Hi!\n";
}
1;
test.pl
use Class;
# Instantiate an object from the class
my $obj = Class->new();
$obj->do_something();
In this example you can see that you would first instantiate an instance of the class, then call the method from the created object.
The same end result can be achieved like so:
Module.pm
package Module;
use strict;
use warnings;
sub do_something {
print "Hi!\n";
}
1;
test.pl
use Module;
Module::do_something();
I am wondering why people write modules using the first approach, and if there is some benefit that it provides. To me it seems like it adds an extra step, because in order to use the methods, you first need to instantiate an object of the class.
I don't understand why people would program like this unless it has some benefit that I am not seeing.
One benefit is inheritance. You can subclass behavior of an existing class if it supports the -> style subroutine calls (which is a weaker statement than saying the class is object-oriented, as I said in a comment above).
package Class;
sub new { bless \__PACKAGE__,__PACKAGE__ }
sub do_something { "foo" }
sub do_something_else { 42 }
1;
package Subclass;
#Sublcass::ISA = qw(Class);
sub new { bless \__PACKAGE__,__PACKAGE__ }
sub do_something_else { 19 }
package main;
use feature 'say';
$o1 = Class->new;
$o2 = Subclass->new;
say $o1->do_something; # foo
say $o2->do_something; # foo
say $o1->do_something_else; # 42
say $o2->do_something_else; # 19
A prominent use of this technique is the UNIVERSAL class, that all blessed references implicitly subclass. The methods defined in the UNIVERSAL namespace generally take a package name as the first argument (or resolve a reference in the first argument to its package name), are return some package information. The DB class also does something like this (though the DB package also maintains plenty of state).
I have a question related to multi-level inheritance in Perl.
Here is my code
mod.pm
package first;
sub disp {
print "INSIDE FIRST\n";
}
package second;
#ISA = qw(first);
sub disp {
print "INSIDE SECOND\n";
}
package third;
#ISA = qw(second);
sub new {
$class = shift;
$ref = {};
bless $ref, $class;
return $ref;
}
sub show {
$self = shift;
print "INSIDE THIRD\n";
}
1;
prog.pl
use mod;
$obj = third->new();
$obj->show();
$obj->disp();
I have a .pm file which contains three classes. I want to access the disp method in the first class using an object of third class. I'm not sure how that could work.
I tried to access using two ways:
using class name => first::disp()
using SUPER inside second package disp method => $self->SUPER::disp();
But am not sure how it will be accessed directly using the object of third class.
$obj->first::disp(), but what you are asking to do is something you absolutely shouldn't do. Fix your design.
If you need to do that, then you have defined your classes wrongly.
The third class inherits from the second class. second has it's own definition of disp, so it never tries to inherit that method from its superclass first. That means third gets the implementation defined in second
The simple answer would be to call first::disp something else. That way second won't have a definition of the method and inheritance will be invoked again
If you explain the underlying problem, and why you want to ignore an inherited method, then perhaps we can help you find a better way
Please also note that packages and module files should start with a capital letter, and each class is ordinarily in a file of its own, so you would usually use package First in First.pm etc.
I am having troubles mocking a subroutine in another module than where I am running the tests.
I have my tests in a file called ParserTests.pl. I am trying to test a subroutine (parse) in a module LogParser.pm
sub parse {
my ($self) = #_;
my $rr = $self->getRR;
while(1) {
my $result = $self->parseCommitSet();
if ($result eq 2) {
last;
}
my $printStatus = $self->printOut($result);
if (!$printStatus) {
say "Problem occurred with writing to output";
return 0;
}
$self->setRR(ReportRecord->new());
}
return 1;
}
I am trying to mock printOut so that it always returns true. What I am trying to do is this:
#! /usr/bin/perl
use v5.10.0;
use strict;
use warnings;
use Test::More 'no_plan';
use Test::MockObject;
use LogParser;
{other tests…}
my $mock = Test::MockObject->new();
$mock->set_true('LogParser::printOut');
my $test100FH = getTestFH($test100SetsNoPrev);
$logParser = LogParser->new($test100FH);
is($logParser->parse, 1, "im ok?");
close $test100FH;
But this test is failing. Can you tell me why and point me in the right path to get it working correctly for when I test parse()? I read up on a bunch of documentation but something like this is still a bit unclear.
The error is
Can't use an undefined value as a symbol reference at /Users/achu/Documents/workspace/Perl_Script/LogParser.pm line 241, <$fh> line 8371.
# Looks like your test exited with 25 just after 91.
That line (line 241) is inside the printOut subroutine though which means that it's not mocking that subroutine like I wanted it to. What am I doing wrong?
Test::MockModule is probably better suited to this;
my $module = Test::MockModule->new('LogParser');
$module->mock( printOut => sub { return 1 } );
This will cause LogParser to use your mocked version until $module goes out of scope.
Test::MockObject does not quite do what you want. It is good for supplying a minimally-implemented stub. But for making an instance of the class under test and selectively overriding its methods, you want Test::MockObject::Extends.
TMOE takes an instance and then lets you change what some of its methods do. In your example, you can use it to write the test thus:
use Test::MockObject::Extends;
my $test100FH = getTestFH($test100SetsNoPrev);
$logParser = Test::MockObject::Extends->new(
LogParser->new($test100FH);
);
$logParser->set_true('printOut');
is($logParser->parse, 1, "im ok?");
close $test100FH;
You didn't provide the error message, but what you've defined is an object called $mock that contains a 'printout' method. But you're calling printout() on $logparser.
The point of MockObject is to create a very bare object, with a few methods so you can test other pieces of code in a algorithm that relies on an external object. For example, you could mock a database handle so that calling $dbh->fetchStuff() always returns on static row, so that you can test the code that consumes the row.
So without more context, I can't tell the possibilities for just creating a stub for printOut() so that parse knows about it.
That being said, I also don't understand the desire to have a test for the return value of the stubbed method.
Please read the documentation for Test::MockObject and try to understand how it works.
You are doing only the first half of what is actually required: You are creating a mock object. But this will not magically end up in your LogParser.
What Test::MockObject gives you is an object that behaves just like the object you want to mock. Of course, somebody or something still has to use that object. And this will have to be the code you are trying to test.
I simply hate how CGI::Application's accessor for the CGI object is called query.
I would like my instance classes to be able to use an accessor named cgi to get the CGI object associated with the current instance of my CGI::Application subclass.
Here is a self-contained example of what I am doing:
package My::Hello;
sub hello {
my $self =shift;
print "Hello #_\n";
}
package My::Merhaba;
use base 'My::Hello';
sub merhaba {
goto sub { shift->hello(#_) };
}
package main;
My::Merhaba->merhaba('StackOverflow');
This is working as I think it should and I cannot see any problems (say, if I wanted to inherit from My::Merhaba: Subclasses need not know anything about merhaba).
Would it have been better/more correct to write
sub merhaba {
my $self = shift;
return $self->hello(#_);
}
What are the advantages/disadvantages of using goto &NAME for the purpose of aliasing a method name? Is there a better way?
Note: If you have an urge to respond with goto is evil don't do it because this use of Perl's goto is different than what you have in mind.
Your approach with goto is the right one, because it will ensure that caller / wantarray and the like keep working properly.
I would setup the new method like this:
sub merhaba {
if (my $method = eval {$_[0]->can('hello')}) {
goto &$method
} else {
# error code here
}
}
Or if you don't want to use inheritance, you can add the new method to the existing package from your calling code:
*My::Hello::merhaba = \&My::Hello::hello;
# or you can use = My::Hello->can('hello');
then you can call:
My::Hello->merhaba('StackOverflow');
and get the desired result.
Either way would work, the inheritance route is more maintainable, but adding the method to the existing package would result in faster method calls.
Edit:
As pointed out in the comments, there are a few cases were the glob assignment will run afoul with inheritance, so if in doubt, use the first method (creating a new method in a sub package).
Michael Carman suggested combining both techniques into a self redefining function:
sub merhaba {
if (my $method = eval { $_[0]->can('hello') }) {
no warnings 'redefine';
*merhaba = $method;
goto &merhaba;
}
die "Can't make 'merhaba' an alias for 'hello'";
}
You can alias the subroutines by manipulating the symbol table:
*My::Merhaba::merhaba = \&My::Hello::hello;
Some examples can be found here.
I'm not sure what the right way is, but Adam Kennedy uses your second method (i.e. without goto) in Method::Alias (click here to go directly to the source code).
This is sort of a combination of Quick-n-Dirty with a modicum of indirection using UNIVERSAL::can.
package My::Merhaba;
use base 'My::Hello';
# ...
*merhaba = __PACKAGE__->can( 'hello' );
And you'll have a sub called "merhaba" in this package that aliases My::Hello::hello. You are simply saying that whatever this package would otherwise do under the name hello it can do under the name merhaba.
However, this is insufficient in the possibility that some code decorator might change the sub that *My::Hello::hello{CODE} points to. In that case, Method::Alias might be the appropriate way to specify a method, as molecules suggests.
However, if it is a rather well-controlled library where you control both the parent and child categories, then the method above is slimmmer.
Last week I was bitten twice by accidentally overriding methods in a subclass. While I am not a fan of inheritance, we (ab)use this in our application at work. What I would like to do is provide some declarative syntax for stating that a method is overriding a parent method. Something like this:
use Attribute::Override;
use parent 'Some::Class';
sub foo : override { ... } # fails if it doesn't override
sub bar { ... } # fails if it does override
There are a couple of issues here. First, if method loading is delayed somehow (for example, methods loaded via AUTOLOAD or otherwise later installed in the symbol table), this won't detect those methods.
Walking the inheritance tree could also get similarly expensive. I do this with Class::Sniff, but it's not really suitable for running code. I could walk the inheritance tree and simply match where there's a defined CODE slot in the appropriate symbol table and that would be faster, but if the method cache is invalidated, that would break if I were to cache those results.
So I have two questions: is this a reasonable approach and is there a hook which allows me to check if the method cache has changed? (search for 'cache' in 'perldoc perlobj').
Of course, this shouldn't break production code, I am thinking about only having it fail or warn if the TEST_HARNESS environment variable is active (and have an explicit environment variable to force it to be inactive, if production code were to set the TEST_HARNESS environment variable for some reason).
One way to enforce this:
package Base;
...
sub new {
my $class = shift;
...
check_overrides( $class );
...
}
sub check_overrides {
my $class = shift;
for my $method ( #unoverridable ) {
die "horribly" if __PACKAGE__->can( $method ) != $class->can( $method );
}
}
Memoization of check_overrides may be helpful.
If there are some cases where you want exemptions, have an alternate method name and
have the base class call that:
package Base;
...
my #unoverridable = 'DESTROY';
sub destroy {}
sub DESTROY {
my $self = shift;
# do essential stuff
...
$self->destroy();
}