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