Commit | Line | Data |
73e9153a |
1 | package Test::Mouse; |
2 | |
3 | use Mouse::Exporter; |
4 | use Mouse::Util qw(does_role find_meta); |
5 | |
6 | use Test::Builder; |
7 | |
8 | Mouse::Exporter->setup_import_methods( |
9 | as_is => [qw( |
10 | meta_ok |
11 | does_ok |
12 | has_attribute_ok |
13 | )], |
14 | ); |
15 | |
16 | ## the test builder instance ... |
17 | |
18 | my $Test = Test::Builder->new; |
19 | |
20 | ## exported functions |
21 | |
22 | sub meta_ok ($;$) { |
23 | my ($class_or_obj, $message) = @_; |
24 | |
25 | $message ||= "The object has a meta"; |
26 | |
27 | if (find_meta($class_or_obj)) { |
28 | return $Test->ok(1, $message) |
29 | } |
30 | else { |
31 | return $Test->ok(0, $message); |
32 | } |
33 | } |
34 | |
35 | sub does_ok ($$;$) { |
36 | my ($class_or_obj, $does, $message) = @_; |
37 | |
38 | $message ||= "The object does $does"; |
39 | |
40 | if (does_role($class_or_obj, $does)) { |
41 | return $Test->ok(1, $message) |
42 | } |
43 | else { |
44 | return $Test->ok(0, $message); |
45 | } |
46 | } |
47 | |
48 | sub has_attribute_ok ($$;$) { |
49 | my ($class_or_obj, $attr_name, $message) = @_; |
50 | |
51 | $message ||= "The object does has an attribute named $attr_name"; |
52 | |
53 | my $meta = find_meta($class_or_obj); |
54 | |
55 | if ($meta->find_attribute_by_name($attr_name)) { |
56 | return $Test->ok(1, $message) |
57 | } |
58 | else { |
59 | return $Test->ok(0, $message); |
60 | } |
61 | } |
62 | |
63 | 1; |
64 | __END__ |
65 | |
66 | =head1 NAME |
67 | |
68 | Test::Mouse - Test functions for Mouse specific features |
69 | |
70 | =head1 SYNOPSIS |
71 | |
72 | use Test::More plan => 1; |
73 | use Test::Mouse; |
74 | |
75 | meta_ok($class_or_obj, "... Foo has a ->meta"); |
76 | does_ok($class_or_obj, $role, "... Foo does the Baz role"); |
77 | has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute"); |
78 | |
79 | =head1 DESCRIPTION |
80 | |
81 | This module provides some useful test functions for Mouse based classes. It |
82 | is an experimental first release, so comments and suggestions are very welcome. |
83 | |
84 | =head1 EXPORTED FUNCTIONS |
85 | |
86 | =over 4 |
87 | |
88 | =item B<meta_ok ($class_or_object)> |
89 | |
90 | Tests if a class or object has a metaclass. |
91 | |
92 | =item B<does_ok ($class_or_object, $role, ?$message)> |
93 | |
94 | Tests if a class or object does a certain role, similar to what C<isa_ok> |
95 | does for the C<isa> method. |
96 | |
97 | =item B<has_attribute_ok($class_or_object, $attr_name, ?$message)> |
98 | |
99 | Tests if a class or object has a certain attribute, similar to what C<can_ok> |
100 | does for the methods. |
101 | |
102 | =back |
103 | |
104 | =head1 SEE ALSO |
105 | |
106 | =over 4 |
107 | |
108 | =item L<Test::More> |
109 | |
110 | =back |
111 | |
112 | =head1 SEE ALSO |
113 | |
114 | L<Mouse> |
115 | |
116 | L<Test::Moose> |
117 | |
118 | =cut |
119 | |