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 | my @exports = qw[ |
13 | meta_ok |
d03bd989 |
14 | does_ok |
7125b244 |
15 | has_attribute_ok |
f2ca7ada |
16 | with_immutable |
7125b244 |
17 | ]; |
9a641848 |
18 | |
7125b244 |
19 | Sub::Exporter::setup_exporter({ |
20 | exports => \@exports, |
21 | groups => { default => \@exports } |
22 | }); |
9a641848 |
23 | |
6532ca5a |
24 | ## the test builder instance ... |
9a641848 |
25 | |
6532ca5a |
26 | my $Test = Test::Builder->new; |
9a641848 |
27 | |
7125b244 |
28 | ## exported functions |
9a641848 |
29 | |
7125b244 |
30 | sub meta_ok ($;$) { |
31 | my ($class_or_obj, $message) = @_; |
d03bd989 |
32 | |
7125b244 |
33 | $message ||= "The object has a meta"; |
d03bd989 |
34 | |
6532ca5a |
35 | if (find_meta($class_or_obj)) { |
7125b244 |
36 | return $Test->ok(1, $message) |
37 | } |
38 | else { |
d03bd989 |
39 | return $Test->ok(0, $message); |
7125b244 |
40 | } |
9a641848 |
41 | } |
42 | |
43 | sub does_ok ($$;$) { |
7125b244 |
44 | my ($class_or_obj, $does, $message) = @_; |
d03bd989 |
45 | |
7125b244 |
46 | $message ||= "The object does $does"; |
d03bd989 |
47 | |
6532ca5a |
48 | if (does_role($class_or_obj, $does)) { |
7125b244 |
49 | return $Test->ok(1, $message) |
50 | } |
51 | else { |
d03bd989 |
52 | return $Test->ok(0, $message); |
7125b244 |
53 | } |
54 | } |
9a641848 |
55 | |
7125b244 |
56 | sub has_attribute_ok ($$;$) { |
57 | my ($class_or_obj, $attr_name, $message) = @_; |
d03bd989 |
58 | |
7125b244 |
59 | $message ||= "The object does has an attribute named $attr_name"; |
d03bd989 |
60 | |
61 | my $meta = find_meta($class_or_obj); |
62 | |
7125b244 |
63 | if ($meta->find_attribute_by_name($attr_name)) { |
64 | return $Test->ok(1, $message) |
65 | } |
66 | else { |
d03bd989 |
67 | return $Test->ok(0, $message); |
68 | } |
9a641848 |
69 | } |
70 | |
f2ca7ada |
71 | sub with_immutable (&@) { |
72 | my $block = shift; |
92c04d5e |
73 | my $before = $Test->current_test; |
f2ca7ada |
74 | $block->(); |
ed544690 |
75 | Class::MOP::class_of($_)->make_immutable for @_; |
f2ca7ada |
76 | $block->(); |
92c04d5e |
77 | my $num_tests = $Test->current_test - $before; |
78 | return all { $_ } ($Test->summary)[-$num_tests..-1]; |
f2ca7ada |
79 | } |
80 | |
9a641848 |
81 | 1; |
82 | |
ad46f524 |
83 | # ABSTRACT: Test functions for Moose specific features |
84 | |
9a641848 |
85 | __END__ |
86 | |
87 | =pod |
88 | |
9a641848 |
89 | =head1 SYNOPSIS |
90 | |
7125b244 |
91 | use Test::More plan => 1; |
d03bd989 |
92 | use Test::Moose; |
9a641848 |
93 | |
7125b244 |
94 | meta_ok($class_or_obj, "... Foo has a ->meta"); |
95 | does_ok($class_or_obj, $role, "... Foo does the Baz role"); |
96 | has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute"); |
9a641848 |
97 | |
7125b244 |
98 | =head1 DESCRIPTION |
99 | |
d03bd989 |
100 | This module provides some useful test functions for Moose based classes. It |
7125b244 |
101 | is an experimental first release, so comments and suggestions are very welcome. |
102 | |
103 | =head1 EXPORTED FUNCTIONS |
9a641848 |
104 | |
105 | =over 4 |
106 | |
7125b244 |
107 | =item B<meta_ok ($class_or_object)> |
108 | |
109 | Tests if a class or object has a metaclass. |
110 | |
111 | =item B<does_ok ($class_or_object, $role, ?$message)> |
9a641848 |
112 | |
d03bd989 |
113 | Tests if a class or object does a certain role, similar to what C<isa_ok> |
7125b244 |
114 | does for the C<isa> method. |
9a641848 |
115 | |
7125b244 |
116 | =item B<has_attribute_ok($class_or_object, $attr_name, ?$message)> |
117 | |
d03bd989 |
118 | Tests if a class or object has a certain attribute, similar to what C<can_ok> |
7125b244 |
119 | does for the methods. |
120 | |
2cc69b87 |
121 | =item B<with_immutable { CODE } @class_names> |
122 | |
d8d59909 |
123 | Runs B<CODE> (which should contain normal tests) twice, and make each |
124 | class in C<@class_names> immutable in between the two runs. |
2cc69b87 |
125 | |
7125b244 |
126 | =back |
127 | |
128 | =head1 TODO |
129 | |
130 | =over 4 |
131 | |
132 | =item Convert the Moose test suite to use this module. |
133 | |
134 | =item Here is a list of possible functions to write |
135 | |
136 | =over 4 |
137 | |
138 | =item immutability predicates |
139 | |
140 | =item anon-class predicates |
141 | |
142 | =item discovering original method from modified method |
143 | |
144 | =item attribute metaclass predicates (attribute_isa?) |
145 | |
146 | =back |
9a641848 |
147 | |
148 | =back |
149 | |
150 | =head1 SEE ALSO |
151 | |
152 | =over 4 |
153 | |
154 | =item L<Test::More> |
155 | |
156 | =back |
157 | |
158 | =head1 BUGS |
159 | |
d4048ef3 |
160 | See L<Moose/BUGS> for details on reporting bugs. |
9a641848 |
161 | |
9a641848 |
162 | =cut |
163 | |