如何模拟 Moo 角色中定义的方法？

Question

鉴于以下角色：

package MyRole;
use Moo::Role;

sub foo { 
    return 'blah';
}

以及以下消耗 class：

package MyClass;
use Moo;
with 'MyRole';

around foo = sub { 
    my ($orig, $self) = @_;
    return 'bak' if $self->$orig eq 'baz';
    return $self->$orig;
}

我想测试 around 修饰符中定义的行为。我该怎么做呢？ Test::MockModule好像不行：

use MyClass;
use Test::Most;
use Test::MockModule;

my $mock = Test::MockModule->new('MyRole');
$mock->mock('foo' => sub { return 'baz' });

my $obj = MyClass->new;
# Does not work
is $obj->foo, 'bak', 'Foo is what it oughtta be';

EDIT：我要测试的是 interaction MyClass 与 around 中定义的 MyRole修饰符。我想测试 around 修饰符中的代码是否按照我认为的方式执行。这是另一个更接近我的实际代码的例子：

package MyRole2
use Moo::Role;

sub call {
    my $self = shift;
    # Connect to server, retrieve a document
    my $document = $self->get_document;
    return $document;
}

package MyClass2;
use Moo;
with 'MyRole2';

around call = sub { 
    my ($orig, $self) = @_;
    my $document = $self->$orig;
    if (has_error($document)) {
        die 'Error';
    }
    return parse($document);
};

所以我想在这里做的是模拟 MyRole2::call 到 return 一个静态文档，在我的测试装置中定义，它包含错误并测试是否正确抛出异常。我知道如何使用 Test::More::throws_ok 或类似的方法对其进行测试。我不知道该怎么做是模拟 MyRole2::call 和 not MyClass2::call.

Answer 1

可以用Test::MockModule

来完成

这些是所需的小改动：

around foo { 应该写成 around foo => sub { 因为 around 需要一个子例程引用。
$self->$orig需要写成$self->($orig)
文档将其列为 my ($orig, $self) = @_; 所以我将其更改为 $orig->($self);

这是一个工作版本：

MyRole.pm

package MyRole;
use Moo::Role;

sub foo { 
    return 'foo blah';
}

sub bar { 
    return 'bar blah';
}

1;

MyClass.pm

package MyClass;

use Moo;
with 'MyRole';

around foo => sub { 
    my ($orig, $self) = (@_);
    my ($result) = $orig->($self);
    return 'bak' if $result eq 'baz'; # Will never return 'bak' as coded.
    return $result;
};

test.t

#!/usr/bin/env perl

use MyClass;
use Test::Most;
use Test::MockModule;

my $obj = MyClass->new;
# foo has an around block, bar does not
is($obj->bar, 'bar blah', 'bar() returns [ bar blah ]');
is($obj->foo, 'foo blah', 'foo() returns [ foo blah ]');

my $mock = Test::MockModule->new('MyClass');
$mock->mock('foo' => sub { return 'mocked foo blah' } );

my $mocked = MyClass->new;
is($mocked->bar, 'bar blah', 'bar() still returns [ bar blah ]');
is($mocked->foo, 'mocked foo blah', 'foo() now returns mocked answer [ mocked foo blah ]');

运行这

prove -v test.t
test.t .. 
ok 1 - bar() returns [ bar blah ]
ok 2 - foo() returns [ foo blah ]
ok 3 - bar() still returns [ bar blah ]
ok 4 - foo() now returns mocked answer [ mocked foo blah ]
1..4
ok
All tests successful.
Files=1, Tests=4,  0 wallclock secs ( 0.06 usr  0.01 sys +  0.19 cusr  0.00 csys =  0.26 CPU)
Result: PASS

请看：

Class::Method::Modifiers::around()

Answer 2

来自#moose 上的 mst：

use 5.016;
use Test::Most tests => 1;

require MyRole;

our $orig = MyRole->can('foo');
no warnings 'redefine';
*MyRole::foo = sub { goto &$orig };

{
    local $orig = sub {'baz'};
    require MyClass;
    my $obj = MyClass->new;
    is $obj->foo, 'bak', 'Foo is what it oughtta be'; 
}

诀窍是在加载任何使用它的东西之前覆盖MyRole::foo 。这意味着使用 require MyClass 而不是 use MyClass，因为 use MyClass 转换为 BEGIN { require MyClass } 这会破坏覆盖方法 before 任何东西的整个事情使用它会加载。

如何模拟 Moo 角色中定义的方法？

How do I mock a method defined in a Moo Role?

perl

unit-testing

moose

moo