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
|
## skip Test::Tabs
=pod
=encoding utf-8
=head1 PURPOSE
Test that MooX::Traits can compose L<Package::Variant>-based roles,
and pass arguments to them.
=head1 DEPENDENCIES
This test requires L<Moo>, L<Package::Variant> and L<Test::Fatal>.
Otherwise, it will be skipped.
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
Based on C<< parameterized.t >> from the L<MooseX::Traits> test suite,
by Jonathan Rockway, Tomas Doran, and Karen Etheridge.
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2014 by Toby Inkster, Jonathan Rockway, Tomas Doran, and Karen Etheridge.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
use strict;
use warnings;
use Test::Requires { 'Test::Fatal' => '0' };
{ package AAA; use Test::Requires { 'Moo' => '1.000000' } };
{ package BBB; use Test::Requires { 'Package::Variant' => '0' } };
use Test::More;
use Test::Fatal;
plan tests => 11;
{
package Role;
use Moo::Role;
has 'gorge' => (
is => 'ro',
required => 1,
);
}
{
package PRole;
use Package::Variant
importing => ['Moo::Role'],
subs => [ qw(has around before after with) ];
sub make_variant {
my ($class, $target_package, %p) = @_;
has $p{foo} => (
is => 'ro',
required => 1,
);
}
}
{
package Class;
use Moo;
with 'MooX::Traits';
}
is
exception { Class->new; },
undef,
'making class is OK';
is
exception { Class->new_with_traits; },
undef,
'making class with no traits is OK';
my $a;
is
exception {
$a = Class->new_with_traits(
traits => ['PRole' => { foo => 'OHHAI' }],
OHHAI => 'I FIXED THAT FOR YOU',
);
},
undef,
'prole is applied OK';
isa_ok $a, 'Class';
is $a->OHHAI, 'I FIXED THAT FOR YOU', 'OHHAI accessor works';
is
exception {
undef $a;
$a = Class->new_with_traits(
traits => ['PRole' => { foo => 'OHHAI' }, 'Role'],
OHHAI => 'I FIXED THAT FOR YOU',
gorge => 'three rivers',
);
},
undef,
'prole is applied OK along with a normal role';
can_ok $a, 'OHHAI', 'gorge';
is
exception {
undef $a;
$a = Class->new_with_traits(
traits => ['Role', 'PRole' => { foo => 'OHHAI' }],
OHHAI => 'I FIXED THAT FOR YOU',
gorge => 'columbia river',
);
},
undef,
'prole is applied OK along with a normal role (2)';
can_ok $a, 'OHHAI', 'gorge';
is
exception {
undef $a;
$a = Class->new_with_traits(
traits => ['Role' => { bullshit => 'params', go => 'here' }],
gorge => 'i should have just called this foo',
);
},
undef,
'regular roles with args can be applied, but args are ignored';
can_ok $a, 'gorge';
|
