1use strict;
2use warnings;
3
4{ package TestRole::Role;   use Moose::Role;                                                  }
5{ package TestRole::Role2;  use Moose::Role;                                                  }
6{ package TestRole;         use Moose::Role; with 'TestRole::Role';                           }
7{ package TestClass;        use Moose;       with 'TestRole::Role';                           }
8{ package TestRole::Two;    use Moose::Role; with 'TestRole::Role';   with 'TestRole::Role2'; }
9{ package TestClass::Two;   use Moose;       with 'TestRole::Role';   with 'TestRole::Role2'; }
10{ package TestRole::Fail;   use Moose::Role;                                                  }
11{ package TestClass::Fail;  use Moose;                                                        }
12{ package TestRole::Fail2;  use Moose::Role; with 'TestRole::Role2';                          }
13{ package TestClass::Fail2; use Moose;       with 'TestRole::Role2';                          }
14{ package TestClass::NotMoosey;                                                               }
15
16use Test::Builder::Tester;
17use Test::More;
18use Test::Moose::More;
19
20use TAP::SimpleOutput 'counters';
21
22my $ROLE  = 'TestRole::Role';
23my @ROLES = qw{ TestRole::Role TestRole::Role2 };
24
25note 'single role, default message - OK';
26for my $thing (qw{ TestClass TestRole }) {
27    my ($_ok, $_nok) = counters();
28    test_out $_ok->("$thing does $ROLE");
29    does_ok $thing, $ROLE;
30    test_test "$thing is found to do $ROLE correctly";
31}
32
33note 'single role, custom message - OK';
34for my $thing (qw{ TestClass TestRole }) {
35    my ($_ok, $_nok) = counters();
36    test_out $_ok->('wah-wah');
37    does_ok $thing, $ROLE, 'wah-wah';
38    test_test "$thing: custom messages work as expected";
39}
40
41note 'single role, "complex" custom message - OK';
42for my $thing (qw{ TestClass TestRole }) {
43    my ($_ok, $_nok) = counters();
44    test_out $_ok->("wah-wah $ROLE");
45    does_ok $thing, $ROLE, 'wah-wah %s';
46    test_test "$thing: 'complex' custom messages work as expected";
47}
48
49note 'multiple roles, default message - OK';
50for my $thing (qw{ TestClass::Two TestRole::Two }) {
51    # role - OK
52    my ($_ok, $_nok) = counters();
53    test_out $_ok->("$thing does $_") for @ROLES;
54    does_ok $thing, [ @ROLES ];
55    test_test "$thing is found to do the roles correctly";
56}
57
58note 'multiple roles, custom message - OK';
59for my $thing (qw{ TestClass::Two TestRole::Two }) {
60    # role - OK
61    my ($_ok, $_nok) = counters();
62    my $msg = 'wah-wah';
63    test_out $_ok->($msg) for @ROLES;
64    does_ok $thing, [ @ROLES ], $msg;
65    test_test "$thing: multiple roles, custom messages work as expected";
66}
67
68note 'multiple roles, "complex" custom message - OK';
69for my $thing (qw{ TestClass::Two TestRole::Two }) {
70    # role - OK
71    my ($_ok, $_nok) = counters();
72    my $msg = 'wah-wah';
73    test_out $_ok->("$msg $_") for @ROLES;
74    does_ok $thing, [ @ROLES ], "$msg %s";
75    test_test "$thing: multiple roles, 'complex' custom messages work as expected";
76}
77
78note 'role - NOT OK';
79for my $thing (qw{ TestClass::Fail TestRole::Fail }) {
80    # role - NOT OK
81    my ($_ok, $_nok) = counters();
82    test_out $_nok->("$thing does $ROLE");
83    test_fail 1;
84    does_ok $thing, $ROLE;
85    test_test "$thing is found to not do $ROLE correctly";
86}
87
88note 'multiple roles - NOT OK';
89for my $thing (qw{ TestClass::Fail TestRole::Fail }) {
90    # role - OK
91    my ($_ok, $_nok) = counters();
92    do { test_out $_nok->("$thing does $_"); test_fail 1 } for @ROLES;
93    does_ok $thing, [ @ROLES ];
94    test_test "$thing: multiple roles fail as expected";
95}
96
97note 'multiple roles - PARTIALLY OK';
98for my $thing (qw{ TestClass::Fail2 TestRole::Fail2 }) {
99    # role - OK
100    my ($_ok, $_nok) = counters();
101    do { test_out $_nok->("$thing does $_"); test_fail 2 } for $ROLES[0];
102    do { test_out $_ok->("$thing does $_")               } for $ROLES[1];
103    does_ok $thing, [ @ROLES ];
104    test_test "$thing: multiple roles partially fail as expected";
105}
106
107note 'Class::MOP metaclass';
108my $cmop_thing = 'TestClass::CMOP';
109my $cmop_meta  = Class::MOP::Class->create($cmop_thing => (methods => { foo => sub { 1 } }));
110{
111    my ($_ok, $_nok) = counters();
112    test_out $_nok->("$cmop_thing does $ROLE");
113    test_fail 1;
114    does_ok $cmop_thing => $ROLE;
115    test_test q{Class::MOP metaclasses don't ever do roles};
116}
117
118done_testing;
119