Commit | Line | Data |
4060c871 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 9; |
7 | use Test::Exception; |
8 | |
9 | |
10 | |
11 | { |
12 | package Foo::Role; |
13 | use Mouse::Role; |
14 | use Mouse::Util::TypeConstraints; |
15 | |
16 | # if does() exists on its own, then |
17 | # we create a type constraint for |
18 | # it, just as we do for isa() |
19 | has 'bar' => (is => 'rw', does => 'Bar::Role'); |
20 | has 'baz' => ( |
21 | is => 'rw', |
4c98ebb0 |
22 | does => 'Bar::Role' |
4060c871 |
23 | ); |
24 | |
25 | package Bar::Role; |
26 | use Mouse::Role; |
27 | |
28 | # if isa and does appear together, then see if Class->does(Role) |
29 | # if it does work... then the does() check is actually not needed |
30 | # since the isa() check will imply the does() check |
31 | has 'foo' => (is => 'rw', isa => 'Foo::Class', does => 'Foo::Role'); |
32 | |
33 | package Foo::Class; |
34 | use Mouse; |
35 | |
36 | with 'Foo::Role'; |
37 | |
38 | package Bar::Class; |
39 | use Mouse; |
40 | |
41 | with 'Bar::Role'; |
42 | |
43 | } |
44 | |
45 | my $foo = Foo::Class->new; |
46 | isa_ok($foo, 'Foo::Class'); |
47 | |
48 | my $bar = Bar::Class->new; |
49 | isa_ok($bar, 'Bar::Class'); |
50 | |
51 | lives_ok { |
52 | $foo->bar($bar); |
53 | } '... bar passed the type constraint okay'; |
54 | |
55 | dies_ok { |
56 | $foo->bar($foo); |
57 | } '... foo did not pass the type constraint okay'; |
58 | |
59 | lives_ok { |
60 | $foo->baz($bar); |
61 | } '... baz passed the type constraint okay'; |
62 | |
63 | dies_ok { |
64 | $foo->baz($foo); |
65 | } '... foo did not pass the type constraint okay'; |
66 | |
67 | lives_ok { |
68 | $bar->foo($foo); |
69 | } '... foo passed the type constraint okay'; |
70 | |
71 | |
72 | |
73 | # some error conditions |
74 | |
75 | { |
76 | package Baz::Class; |
77 | use Test::More; |
78 | use Mouse; |
79 | |
80 | local $TODO = 'setting both isa and does'; |
81 | |
82 | # if isa and does appear together, then see if Class->does(Role) |
83 | # if it does not,.. we have a conflict... so we die loudly |
84 | ::dies_ok { |
85 | has 'foo' => (isa => 'Foo::Class', does => 'Bar::Class'); |
86 | } '... cannot have a does() which is not done by the isa()'; |
87 | } |
88 | |
89 | { |
90 | package Bling; |
91 | use strict; |
92 | use warnings; |
93 | |
94 | sub bling { 'Bling::bling' } |
95 | |
96 | package Bling::Bling; |
97 | use Test::More; |
98 | use Mouse; |
99 | |
100 | local $TODO = 'setting both isa and does'; |
101 | |
102 | # if isa and does appear together, then see if Class->does(Role) |
103 | # if it does not,.. we have a conflict... so we die loudly |
104 | ::dies_ok { |
105 | has 'foo' => (isa => 'Bling', does => 'Bar::Class'); |
106 | } '... cannot have a isa() which is cannot does()'; |
107 | } |
108 | |
109 | |
110 | |