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