File: 006-requires.t

package info (click to toggle)
libmoosex-role-parameterized-perl 1.11-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid, trixie
  • size: 464 kB
  • sloc: perl: 439; makefile: 2
file content (86 lines) | stat: -rw-r--r-- 1,925 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
use strict;
use warnings;
use Test::More 0.88;
use Test::Fatal;

do {
    package MyRole::Requires;
    use MooseX::Role::Parameterized;

    parameter requires => (
        is  => 'rw',
        isa => 'Str',
    );

    role {
        my $p = shift;
        requires $p->requires;
    };
};

my @keep_roles_alive;
sub requires_names {
    map {
        my $role = MyRole::Requires->meta->generate_role(
            parameters => {
                requires => $_,
            },
        );
        push @keep_roles_alive, $role;
        $role->name;
    } @_
}

{
    my ($role_name) = requires_names('alpha');
    like( exception {
        Moose::Meta::Class->create_anon_class(
            roles => [ $role_name ],
        );
    }, qr/'$role_name' requires the method 'alpha' to be implemented by '[\w:]+'/);
}

is (exception {
    Moose::Meta::Class->create_anon_class(
        methods => {
            alpha => sub {},
        },
        roles => [ requires_names('alpha') ],
    );
}, undef);

{
    my ($role1, $role2) = requires_names('alpha', 'beta');
    like( exception {
        Moose::Meta::Class->create_anon_class(
            methods => {
                alpha => sub {},
            },
            roles => [ $role1, $role2 ],
        );
    }, qr/'$role1\|$role2' requires the method 'beta' to be implemented by '[\w:]+'/);
}

{
    my ($role1, $role2) = requires_names('alpha', 'beta');
    like( exception {
        Moose::Meta::Class->create_anon_class(
            methods => {
                beta => sub {},
            },
            roles => [ $role1, $role2 ],
        );
    }, qr/'$role1\|$role2' requires the method 'alpha' to be implemented by '[\w:]+'/);
}

is (exception {
    Moose::Meta::Class->create_anon_class(
        methods => {
            alpha => sub {},
            beta => sub {},
        },
        roles => [ requires_names('alpha', 'beta') ],
    );
}, undef);

done_testing;