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 | |
92c04d5e |
9 | use List::MoreUtils 'all'; |
6532ca5a |
10 | use Moose::Util 'does_role', 'find_meta'; |
9a641848 |
11 | |
7125b244 |
12 | our $AUTHORITY = 'cpan:STEVAN'; |
9a641848 |
13 | |
7125b244 |
14 | my @exports = qw[ |
15 | meta_ok |
d03bd989 |
16 | does_ok |
7125b244 |
17 | has_attribute_ok |
f2ca7ada |
18 | with_immutable |
7125b244 |
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 | |
f2ca7ada |
73 | sub with_immutable (&@) { |
74 | my $block = shift; |
92c04d5e |
75 | my $before = $Test->current_test; |
f2ca7ada |
76 | $block->(); |
ed544690 |
77 | Class::MOP::class_of($_)->make_immutable for @_; |
f2ca7ada |
78 | $block->(); |
92c04d5e |
79 | my $num_tests = $Test->current_test - $before; |
80 | return all { $_ } ($Test->summary)[-$num_tests..-1]; |
f2ca7ada |
81 | } |
82 | |
9a641848 |
83 | 1; |
84 | |
ad46f524 |
85 | # ABSTRACT: Test functions for Moose specific features |
86 | |
9a641848 |
87 | __END__ |
88 | |
89 | =pod |
90 | |
9a641848 |
91 | =head1 SYNOPSIS |
92 | |
7125b244 |
93 | use Test::More plan => 1; |
d03bd989 |
94 | use Test::Moose; |
9a641848 |
95 | |
7125b244 |
96 | meta_ok($class_or_obj, "... Foo has a ->meta"); |
97 | does_ok($class_or_obj, $role, "... Foo does the Baz role"); |
98 | has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute"); |
9a641848 |
99 | |
7125b244 |
100 | =head1 DESCRIPTION |
101 | |
d03bd989 |
102 | This module provides some useful test functions for Moose based classes. It |
7125b244 |
103 | is an experimental first release, so comments and suggestions are very welcome. |
104 | |
105 | =head1 EXPORTED FUNCTIONS |
9a641848 |
106 | |
107 | =over 4 |
108 | |
7125b244 |
109 | =item B<meta_ok ($class_or_object)> |
110 | |
111 | Tests if a class or object has a metaclass. |
112 | |
113 | =item B<does_ok ($class_or_object, $role, ?$message)> |
9a641848 |
114 | |
d03bd989 |
115 | Tests if a class or object does a certain role, similar to what C<isa_ok> |
7125b244 |
116 | does for the C<isa> method. |
9a641848 |
117 | |
7125b244 |
118 | =item B<has_attribute_ok($class_or_object, $attr_name, ?$message)> |
119 | |
d03bd989 |
120 | Tests if a class or object has a certain attribute, similar to what C<can_ok> |
7125b244 |
121 | does for the methods. |
122 | |
2cc69b87 |
123 | =item B<with_immutable { CODE } @class_names> |
124 | |
d8d59909 |
125 | Runs B<CODE> (which should contain normal tests) twice, and make each |
126 | class in C<@class_names> immutable in between the two runs. |
2cc69b87 |
127 | |
7125b244 |
128 | =back |
129 | |
130 | =head1 TODO |
131 | |
132 | =over 4 |
133 | |
134 | =item Convert the Moose test suite to use this module. |
135 | |
136 | =item Here is a list of possible functions to write |
137 | |
138 | =over 4 |
139 | |
140 | =item immutability predicates |
141 | |
142 | =item anon-class predicates |
143 | |
144 | =item discovering original method from modified method |
145 | |
146 | =item attribute metaclass predicates (attribute_isa?) |
147 | |
148 | =back |
9a641848 |
149 | |
150 | =back |
151 | |
152 | =head1 SEE ALSO |
153 | |
154 | =over 4 |
155 | |
156 | =item L<Test::More> |
157 | |
158 | =back |
159 | |
160 | =head1 BUGS |
161 | |
d4048ef3 |
162 | See L<Moose/BUGS> for details on reporting bugs. |
9a641848 |
163 | |
9a641848 |
164 | =cut |
165 | |