Commit | Line | Data |
6cfa1e5e |
1 | package Test::Mouse;\r |
2 | \r |
3 | use strict;\r |
4 | use warnings;\r |
5 | use Mouse ();\r |
6 | \r |
7 | use base qw(Test::Builder::Module);\r |
8 | \r |
9 | our @EXPORT = qw(meta_ok does_ok has_attribute_ok);\r |
10 | \r |
11 | sub find_meta{ Mouse::class_of($class_or_obj) }\r |
12 | \r |
13 | sub meta_ok ($;$) {\r |
14 | my ($class_or_obj, $message) = @_;\r |
15 | \r |
16 | $message ||= "The object has a meta";\r |
17 | \r |
18 | if (find_meta($class_or_obj)) {\r |
19 | return __PACKAGE__->builder->ok(1, $message)\r |
20 | }\r |
21 | else {\r |
22 | return __PACKAGE__->builder->ok(0, $message);\r |
23 | }\r |
24 | }\r |
25 | \r |
26 | sub does_ok ($$;$) {\r |
27 | my ($class_or_obj, $does, $message) = @_;\r |
28 | \r |
29 | $message ||= "The object does $does";\r |
30 | \r |
31 | my $meta = find_meta($class_or_obj);\r |
32 | if ($meta && $meta->does_role($does)) {\r |
33 | return __PACKAGE__->builder->ok(1, $message)\r |
34 | }\r |
35 | else {\r |
36 | return __PACKAGE__->builder->ok(0, $message);\r |
37 | }\r |
38 | }\r |
39 | \r |
40 | sub has_attribute_ok ($$;$) {\r |
41 | my ($class_or_obj, $attr_name, $message) = @_;\r |
42 | \r |
43 | $message ||= "The object does has an attribute named $attr_name";\r |
44 | \r |
45 | my $meta = find_meta($class_or_obj);\r |
46 | \r |
47 | if ($meta->find_attribute_by_name($attr_name)) {\r |
48 | return __PACKAGE__->builder->ok(1, $message)\r |
49 | }\r |
50 | else {\r |
51 | return __PACKAGE__->builder->ok(0, $message);\r |
52 | }\r |
53 | }\r |
54 | \r |
55 | 1;\r |
56 | \r |
57 | __END__\r |
58 | \r |
59 | =pod\r |
60 | \r |
61 | =head1 NAME\r |
62 | \r |
63 | Test::Mouse - Test functions for Mouse specific features\r |
64 | \r |
65 | =head1 SYNOPSIS\r |
66 | \r |
67 | use Test::More plan => 1;\r |
68 | use Test::Mouse;\r |
69 | \r |
70 | meta_ok($class_or_obj, "... Foo has a ->meta");\r |
71 | does_ok($class_or_obj, $role, "... Foo does the Baz role");\r |
72 | has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute");\r |
73 | \r |
74 | =cut\r |
75 | \r |