Commit | Line | Data |
9a641848 |
1 | package Test::Moose; |
2 | |
9a641848 |
3 | use strict; |
4 | use warnings; |
5 | |
7125b244 |
6 | use Sub::Exporter; |
7 | use Test::Builder; |
004222dc |
8 | |
6532ca5a |
9 | use Moose::Util 'does_role', 'find_meta'; |
9a641848 |
10 | |
e3d94ac0 |
11 | our $VERSION = '0.82'; |
75b95414 |
12 | $VERSION = eval $VERSION; |
7125b244 |
13 | our $AUTHORITY = 'cpan:STEVAN'; |
9a641848 |
14 | |
7125b244 |
15 | my @exports = qw[ |
16 | meta_ok |
d03bd989 |
17 | does_ok |
7125b244 |
18 | has_attribute_ok |
19 | ]; |
9a641848 |
20 | |
7125b244 |
21 | Sub::Exporter::setup_exporter({ |
22 | exports => \@exports, |
23 | groups => { default => \@exports } |
24 | }); |
9a641848 |
25 | |
6532ca5a |
26 | ## the test builder instance ... |
9a641848 |
27 | |
6532ca5a |
28 | my $Test = Test::Builder->new; |
9a641848 |
29 | |
7125b244 |
30 | ## exported functions |
9a641848 |
31 | |
7125b244 |
32 | sub meta_ok ($;$) { |
33 | my ($class_or_obj, $message) = @_; |
d03bd989 |
34 | |
7125b244 |
35 | $message ||= "The object has a meta"; |
d03bd989 |
36 | |
6532ca5a |
37 | if (find_meta($class_or_obj)) { |
7125b244 |
38 | return $Test->ok(1, $message) |
39 | } |
40 | else { |
d03bd989 |
41 | return $Test->ok(0, $message); |
7125b244 |
42 | } |
9a641848 |
43 | } |
44 | |
45 | sub does_ok ($$;$) { |
7125b244 |
46 | my ($class_or_obj, $does, $message) = @_; |
d03bd989 |
47 | |
7125b244 |
48 | $message ||= "The object does $does"; |
d03bd989 |
49 | |
6532ca5a |
50 | if (does_role($class_or_obj, $does)) { |
7125b244 |
51 | return $Test->ok(1, $message) |
52 | } |
53 | else { |
d03bd989 |
54 | return $Test->ok(0, $message); |
7125b244 |
55 | } |
56 | } |
9a641848 |
57 | |
7125b244 |
58 | sub has_attribute_ok ($$;$) { |
59 | my ($class_or_obj, $attr_name, $message) = @_; |
d03bd989 |
60 | |
7125b244 |
61 | $message ||= "The object does has an attribute named $attr_name"; |
d03bd989 |
62 | |
63 | my $meta = find_meta($class_or_obj); |
64 | |
7125b244 |
65 | if ($meta->find_attribute_by_name($attr_name)) { |
66 | return $Test->ok(1, $message) |
67 | } |
68 | else { |
d03bd989 |
69 | return $Test->ok(0, $message); |
70 | } |
9a641848 |
71 | } |
72 | |
73 | 1; |
74 | |
75 | __END__ |
76 | |
77 | =pod |
78 | |
79 | =head1 NAME |
80 | |
81 | Test::Moose - Test functions for Moose specific features |
82 | |
83 | =head1 SYNOPSIS |
84 | |
7125b244 |
85 | use Test::More plan => 1; |
d03bd989 |
86 | use Test::Moose; |
9a641848 |
87 | |
7125b244 |
88 | meta_ok($class_or_obj, "... Foo has a ->meta"); |
89 | does_ok($class_or_obj, $role, "... Foo does the Baz role"); |
90 | has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute"); |
9a641848 |
91 | |
7125b244 |
92 | =head1 DESCRIPTION |
93 | |
d03bd989 |
94 | This module provides some useful test functions for Moose based classes. It |
7125b244 |
95 | is an experimental first release, so comments and suggestions are very welcome. |
96 | |
97 | =head1 EXPORTED FUNCTIONS |
9a641848 |
98 | |
99 | =over 4 |
100 | |
7125b244 |
101 | =item B<meta_ok ($class_or_object)> |
102 | |
103 | Tests if a class or object has a metaclass. |
104 | |
105 | =item B<does_ok ($class_or_object, $role, ?$message)> |
9a641848 |
106 | |
d03bd989 |
107 | Tests if a class or object does a certain role, similar to what C<isa_ok> |
7125b244 |
108 | does for the C<isa> method. |
9a641848 |
109 | |
7125b244 |
110 | =item B<has_attribute_ok($class_or_object, $attr_name, ?$message)> |
111 | |
d03bd989 |
112 | Tests if a class or object has a certain attribute, similar to what C<can_ok> |
7125b244 |
113 | does for the methods. |
114 | |
115 | =back |
116 | |
117 | =head1 TODO |
118 | |
119 | =over 4 |
120 | |
121 | =item Convert the Moose test suite to use this module. |
122 | |
123 | =item Here is a list of possible functions to write |
124 | |
125 | =over 4 |
126 | |
127 | =item immutability predicates |
128 | |
129 | =item anon-class predicates |
130 | |
131 | =item discovering original method from modified method |
132 | |
133 | =item attribute metaclass predicates (attribute_isa?) |
134 | |
135 | =back |
9a641848 |
136 | |
137 | =back |
138 | |
139 | =head1 SEE ALSO |
140 | |
141 | =over 4 |
142 | |
143 | =item L<Test::More> |
144 | |
145 | =back |
146 | |
147 | =head1 BUGS |
148 | |
d03bd989 |
149 | All complex software has bugs lurking in it, and this module is no |
9a641848 |
150 | exception. If you find a bug please either email me, or add the bug |
151 | to cpan-RT. |
152 | |
153 | =head1 AUTHOR |
154 | |
155 | Anders Nor Berle E<lt>debolaz@gmail.comE<gt> |
156 | |
7125b244 |
157 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
158 | |
9a641848 |
159 | =head1 COPYRIGHT AND LICENSE |
160 | |
2840a3b2 |
161 | Copyright 2007-2009 by Infinity Interactive, Inc. |
9a641848 |
162 | |
163 | L<http://www.iinteractive.com> |
164 | |
165 | This library is free software; you can redistribute it and/or modify |
d03bd989 |
166 | it under the same terms as Perl itself. |
9a641848 |
167 | |
168 | =cut |
169 | |