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