in reply to Mocking a method defined in a Moo Role

What exactly do you want to test? You don't want to test that around works, it's been already tested in Class::Method::Modifiers. You want to test your class and your role separately.

Here's my example (because yours had several problems, e.g. switched $self and $orig in 'around'):

MyRole.pm:

package MyRole;
use Moo::Role;

sub foo {
    $_[1] ? 'true' : 'false';
}

__PACKAGE__

[download]

MyClass.pm

package MyClass;

use warnings;
use strict;

use Moo;
with 'MyRole';

around foo => sub {
    my $orig = shift;
    my $self = shift;
    my $value = $self->$orig(@_);
    return 'true' eq $value ? 'probably' : $value
};

__PACKAGE__

[download]

To test the role, just create its consumer: 

#!/usr/bin/perl

{   package ConsumerOf::MyRole;
    use Moo;
    with 'MyRole';
}

use Test::Spec;
use Test::Exception;

describe MyRole => sub {
    my $o;
    before each => sub {
        $o = 'ConsumerOf::MyRole'->new;
    };

    it 'knows the foo method' => sub {
        lives_ok { $o->foo };
    };

    it 'foos truth' => sub {
        is $o->foo(1), 'true';
    };

    it 'foos false' => sub {
        is $o->foo(0), 'false';
    };
};

runtests();

[download]

To test the class, just test its behaviour. The fact that it wraps the role is an implementation detail. 

#! /usr/bin/perl
use Test::Spec;

use MyClass;

describe MyClass => sub {
    my $o;
    before each => sub {
        $o = 'MyClass'->new;
    };

    it 'instantiates' => sub {
        isa_ok $o, 'MyClass';
    };

    it 'returns false' => sub {
        is $o->foo(0), 'false';
    };

    it "isn't sure" => sub {
        is $o->foo(1), 'probably';
    };
};

runtests();

[download]

($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

[download]

Replies are listed 'Best First'.
Re^2: Mocking a method defined in a Moo Role
by choroba (Cardinal) on Jun 24, 2016 at 11:50 UTC
    I was able to mock the role, but it's not nice. It seems tools for handling roles in tests aren't there, yet (i.e. there's no does_ok ). 
    #! /usr/bin/perl
use Test::Spec;

require MyClass;  # No use!

my $role_foo;
{   package MyRole;
    use Moo::Role;
    sub foo { $role_foo }
}

describe MyClass => sub {
    my $o;
    before each => sub {
        $o = 'MyClass'->new;
    };

    it 'instantiates' => sub {
        isa_ok $o, 'MyClass';
    };

    it 'returns false' => sub {
        $role_foo = 'false';
        is $o->foo('whatever'), 'false';
    };

    it "isn't sure" => sub {
        $role_foo = 'true';
        is $o->foo('whatever'), 'probably';
    };
};

runtests();

    [download]

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

    [download]
[reply]
[d/l]
[select]
      That's not working for me either, and it seems like it should. Here's the sketch I'm using:

      MyRole.pm

      package MyRole;
use Moo::Role;

sub foo {
    return 'bar';
}
1;

      [download]

      rolesketch.pl

      use 5.016;
package MyClass;

use Moo;
use FindBin qw($Bin);
use lib $Bin;
with 'MyRole';

around foo => sub {
    my ($orig, $self) = @_;

    return 'Wrapped ' . $self->$orig;
};

package main;

package MyRole {
    sub foo { return 'baz' };
};

my $obj = MyClass->new;
my $res = $obj->foo;
if ($res =~ /baz$/) {
    say qq{OK, got $res};
}
else {
    say qq{Not OK, got $res};
}

      [download]
[reply]
[d/l]
[select]

        Thanks to mst on #moose:

        MyClass.pm

        package MyClass;

use Moo;
use FindBin qw($Bin);
use lib $Bin;
with 'MyRole';

around foo => sub {
    my ($orig, $self) = @_;

    return 'Wrapped ' . $self->$orig;
};

        [download]

        rolesketch.pl

        use 5.016;

use FindBin qw($Bin);
use lib qq($Bin);
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;

    my $res = $obj->foo;
    if ( $res =~ /baz$/ ) {
        say qq{OK, got $res};
    }
    else {
        say qq{Not OK, got $res};
    }
}

        [download]
[reply]
[d/l]
[select]
        The following line is missing in MyRole: 
        use Moo::Role;

        [download]

        Also, foo and call are different subs.

        ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

        [download]
[reply]
[d/l]
[select]
Re^2: Mocking a method defined in a Moo Role
by PopeFelix (Beadle) on Jun 24, 2016 at 14:45 UTC

    No, I want to test a behavior that is defined in around(), so I want to mock MyRole::foo to return something specific. I've already tested my class and my role separately. I want to test their interaction.

    Here's another example, a little closer to my actual code (which I can't post):

    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);
};

    [download]

    So what I want to do here is to mock MyRole2::call to return a static document, defined in my test fixtures, that contains errors and test that the exception is thrown properly. I know how to test it using Test::More::throws_ok or similar. What I don't know how to do is to mock MyRole2::call and not MyClass2::call.

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom