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