t/030_roles/004_role_composition_errors.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8
   9
  10 {
  11
  12     package Foo::Role;
  13     use Mouse::Role;
  14
  15     requires 'foo';
  16 }
  17
  18 is_deeply(
  19     [ sort Foo::Role->meta->get_required_method_list ],
  20     ['foo'],
  21     '... the Foo::Role has a required method (foo)'
  22 );
  23
  24 # classes which does not implement required method
  25 {
  26
  27     package Foo::Class;
  28     use Mouse;
  29
  30     ::dies_ok { with('Foo::Role') }
  31         '... no foo method implemented by Foo::Class';
  32 }
  33
  34 # class which does implement required method
  35 {
  36
  37     package Bar::Class;
  38     use Mouse;
  39
  40     ::dies_ok { with('Foo::Class') }
  41         '... cannot consume a class, it must be a role';
  42     ::lives_ok { with('Foo::Role') }
  43         '... has a foo method implemented by Bar::Class';
  44
  45     sub foo {'Bar::Class::foo'}
  46 }
  47
  48 # role which does implement required method
  49 {
  50
  51     package Bar::Role;
  52     use Mouse::Role;
  53
  54     ::lives_ok { with('Foo::Role') }
  55         '... has a foo method implemented by Bar::Role';
  56
  57     sub foo {'Bar::Role::foo'}
  58 }
  59
  60 is_deeply(
  61     [ sort Bar::Role->meta->get_required_method_list ],
  62     [],
  63     '... the Bar::Role has not inherited the required method from Foo::Role'
  64 );
  65
  66 # role which does not implement required method
  67 {
  68
  69     package Baz::Role;
  70     use Mouse::Role;
  71
  72     ::lives_ok { with('Foo::Role') }
  73         '... no foo method implemented by Baz::Role';
  74 }
  75
  76 is_deeply(
  77     [ sort Baz::Role->meta->get_required_method_list ],
  78     ['foo'],
  79     '... the Baz::Role has inherited the required method from Foo::Role'
  80 );
  81
  82 # classes which does not implement required method
  83 {
  84
  85     package Baz::Class;
  86     use Mouse;
  87
  88     ::dies_ok { with('Baz::Role') }
  89         '... no foo method implemented by Baz::Class2';
  90 }
  91
  92 # class which does implement required method
  93 {
  94
  95     package Baz::Class2;
  96     use Mouse;
  97
  98     ::lives_ok { with('Baz::Role') }
  99         '... has a foo method implemented by Baz::Class2';
 100
 101     sub foo {'Baz::Class2::foo'}
 102 }
 103
 104
 105 {
 106     package Quux::Role;
 107     use Mouse::Role;
 108
 109     requires qw( meth1 meth2 meth3 meth4 );
 110 }
 111
 112 # RT #41119
 113 {
 114
 115     package Quux::Class;
 116     use Mouse;
 117
 118     ::throws_ok { with('Quux::Role') }
 119         qr/\Q'Quux::Role' requires the methods 'meth1', 'meth2', 'meth3', and 'meth4' to be implemented by 'Quux::Class'/,
 120         'exception mentions all the missing required methods at once';
 121 }
 122
 123 {
 124     package Quux::Class2;
 125     use Mouse;
 126
 127     sub meth1 { }
 128
 129     ::throws_ok { with('Quux::Role') }
 130         qr/'Quux::Role' requires the methods 'meth2', 'meth3', and 'meth4' to be implemented by 'Quux::Class2'/,
 131         'exception mentions all the missing required methods at once, but not the one that exists';
 132 }
 133
 134 {
 135     package Quux::Class3;
 136     use Mouse;
 137
 138     has 'meth1' => ( is => 'ro' );
 139     has 'meth2' => ( is => 'ro' );
 140
 141     ::throws_ok { with('Quux::Role') }
 142         qr/'Quux::Role' requires the methods 'meth3' and 'meth4' to be implemented by 'Quux::Class3'/,
 143         'exception mentions all the missing methods at once, but not the accessors';
 144 }
 145
 146 {
 147     package Quux::Class4;
 148     use Mouse;
 149
 150     sub meth1 { }
 151     has 'meth2' => ( is => 'ro' );
 152
 153     ::throws_ok { with('Quux::Role') }
 154         qr/'Quux::Role' requires the methods 'meth3' and 'meth4' to be implemented by 'Quux::Class4'/,
 155         'exception mentions all the require methods that are accessors at once, as well as missing methods, but not the one that exists';
 156 }
 157
 158 done_testing;