Commit | Line | Data |
7a50b450 |
1 | #!/usr/bin/perl\r |
2 | \r |
3 | use strict;\r |
4 | use warnings;\r |
5 | \r |
6 | use Test::More tests => 8;\r |
7 | \r |
8 | BEGIN {\r |
9 | use_ok('Mouse::Util', ':all');\r |
10 | }\r |
11 | \r |
12 | {\r |
13 | package Foo;\r |
14 | \r |
15 | use Mouse::Role;\r |
16 | }\r |
17 | \r |
18 | {\r |
19 | package Bar;\r |
20 | \r |
21 | use Mouse;\r |
22 | \r |
23 | with qw/Foo/;\r |
24 | }\r |
25 | \r |
26 | {\r |
27 | package Baz;\r |
28 | \r |
29 | use Mouse;\r |
30 | }\r |
31 | \r |
32 | {\r |
33 | package Quux;\r |
34 | \r |
35 | use metaclass;\r |
36 | }\r |
37 | \r |
38 | {\r |
39 | package Foo::Foo;\r |
40 | \r |
41 | use Mouse::Role;\r |
42 | \r |
43 | with 'Foo';\r |
44 | }\r |
45 | \r |
46 | # Classes\r |
47 | \r |
48 | ok(does_role('Bar', 'Foo'), '... Bar does Foo');\r |
49 | \r |
50 | ok(!does_role('Baz', 'Foo'), '... Baz doesnt do Foo');\r |
51 | \r |
52 | # Objects\r |
53 | \r |
54 | my $bar = Bar->new;\r |
55 | \r |
56 | ok(does_role($bar, 'Foo'), '... $bar does Foo');\r |
57 | \r |
58 | my $baz = Baz->new;\r |
59 | \r |
60 | ok(!does_role($baz, 'Foo'), '... $baz doesnt do Foo');\r |
61 | \r |
62 | # Invalid values\r |
63 | \r |
64 | ok(!does_role(undef,'Foo'), '... undef doesnt do Foo');\r |
65 | \r |
66 | ok(!does_role(1,'Foo'), '... 1 doesnt do Foo');\r |
67 | \r |
68 | # non Mouse metaclass\r |
69 | \r |
70 | ok(!does_role('Quux', 'Foo'), '... Quux doesnt do Foo (does not die tho)');\r |
71 | \r |
72 | # TODO: make the below work, maybe?\r |
73 | \r |
74 | # Self\r |
75 | \r |
76 | #ok(does_role('Foo', 'Foo'), '... Foo does do Foo');\r |
77 | \r |
78 | # sub-Roles\r |
79 | \r |
80 | #ok(does_role('Foo::Foo', 'Foo'), '... Foo::Foo does do Foo');\r |
81 | \r |