File: 004_role_composition_errors.t

package info (click to toggle)
libmoose-perl 1.09-2
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 3,004 kB
  • ctags: 1,472
  • sloc: perl: 25,387; makefile: 2
file content (158 lines) | stat: -rw-r--r-- 3,372 bytes parent folder | download
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Exception;


{

    package Foo::Role;
    use Moose::Role;

    requires 'foo';
}

is_deeply(
    [ sort Foo::Role->meta->get_required_method_list ],
    ['foo'],
    '... the Foo::Role has a required method (foo)'
);

# classes which does not implement required method
{

    package Foo::Class;
    use Moose;

    ::dies_ok { with('Foo::Role') }
        '... no foo method implemented by Foo::Class';
}

# class which does implement required method
{

    package Bar::Class;
    use Moose;

    ::dies_ok { with('Foo::Class') }
        '... cannot consume a class, it must be a role';
    ::lives_ok { with('Foo::Role') }
        '... has a foo method implemented by Bar::Class';

    sub foo {'Bar::Class::foo'}
}

# role which does implement required method
{

    package Bar::Role;
    use Moose::Role;

    ::lives_ok { with('Foo::Role') }
        '... has a foo method implemented by Bar::Role';

    sub foo {'Bar::Role::foo'}
}

is_deeply(
    [ sort Bar::Role->meta->get_required_method_list ],
    [],
    '... the Bar::Role has not inherited the required method from Foo::Role'
);

# role which does not implement required method
{

    package Baz::Role;
    use Moose::Role;

    ::lives_ok { with('Foo::Role') }
        '... no foo method implemented by Baz::Role';
}

is_deeply(
    [ sort Baz::Role->meta->get_required_method_list ],
    ['foo'],
    '... the Baz::Role has inherited the required method from Foo::Role'
);

# classes which does not implement required method
{

    package Baz::Class;
    use Moose;

    ::dies_ok { with('Baz::Role') }
        '... no foo method implemented by Baz::Class2';
}

# class which does implement required method
{

    package Baz::Class2;
    use Moose;

    ::lives_ok { with('Baz::Role') }
        '... has a foo method implemented by Baz::Class2';

    sub foo {'Baz::Class2::foo'}
}


{
    package Quux::Role;
    use Moose::Role;

    requires qw( meth1 meth2 meth3 meth4 );
}

# RT #41119
{

    package Quux::Class;
    use Moose;

    ::throws_ok { with('Quux::Role') }
        qr/\Q'Quux::Role' requires the methods 'meth1', 'meth2', 'meth3', and 'meth4' to be implemented by 'Quux::Class'/,
        'exception mentions all the missing required methods at once';
}

{
    package Quux::Class2;
    use Moose;

    sub meth1 { }

    ::throws_ok { with('Quux::Role') }
        qr/'Quux::Role' requires the methods 'meth2', 'meth3', and 'meth4' to be implemented by 'Quux::Class2'/,
        'exception mentions all the missing required methods at once, but not the one that exists';
}

{
    package Quux::Class3;
    use Moose;

    has 'meth1' => ( is => 'ro' );
    has 'meth2' => ( is => 'ro' );

    ::throws_ok { with('Quux::Role') }
        qr/'Quux::Role' requires the methods 'meth3' and 'meth4' to be implemented by 'Quux::Class3'/,
        'exception mentions all the missing methods at once, but not the accessors';
}

{
    package Quux::Class4;
    use Moose;

    sub meth1 { }
    has 'meth2' => ( is => 'ro' );

    ::throws_ok { with('Quux::Role') }
        qr/'Quux::Role' requires the methods 'meth3' and 'meth4' to be implemented by 'Quux::Class4'/,
        'exception mentions all the require methods that are accessors at once, as well as missing methods, but not the one that exists';
}

done_testing;