1

给定以下角色：

package MyRole;
use Moo::Role;

sub foo { 
    return 'blah';
}

以及以下消费类：

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';

编辑：我要测试的是修饰符中定义的 MyClass 与 MyRole的交互。around我想测试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返回一个静态文档，在我的测试夹具中定义，其中包含错误并测试异常是否被正确抛出。我知道如何使用Test::More::throws_ok或类似方法对其进行测试。我不知道该怎么做是模拟MyRole2::call而不是 MyClass2::call。

4

2 回答 2

1

从 #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 }覆盖该方法的整个过程都失败了。

于 2016-06-24T18:39:36.613 回答
0

它可以用Test::MockModule

这些是所需的小改动：

  1. around foo {应该写，around foo => sub {因为around需要一个子程序引用。

  2. $self->$orig需要写成$self->($orig)

  3. 文档列出了它，my ($orig, $self) = @_;所以我将其更改为 $orig->($self);

这是一个工作版本：

我的角色.pm

package MyRole;
use Moo::Role;

sub foo { 
    return 'foo blah';
}

sub bar { 
    return 'bar blah';
}

1;

我的班级.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;
};

测试.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

请看一看：

类::方法::修饰符::around()

于 2016-06-24T05:30:59.733 回答