Commit | Line | Data |
4403da90 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More 'no_plan'; |
7 | use Test::Exception; |
8 | |
9 | # All the BEGIN blocks are necessary to emulate the behavior of |
10 | # loading modules via use and the similar compile-time effect of "no |
11 | # ..." |
12 | { |
13 | package MooseX::Empty; |
14 | |
15 | use Moose (); |
16 | BEGIN { Moose::Exporter->build_import_methods( also => 'Moose' ); } |
17 | } |
18 | |
19 | { |
20 | package WantsMoose; |
21 | |
22 | BEGIN { MooseX::Empty->import(); } |
23 | |
24 | sub foo { 1 } |
25 | |
26 | BEGIN { |
27 | ::can_ok( 'WantsMoose', 'has' ); |
28 | ::can_ok( 'WantsMoose', 'with' ); |
29 | ::can_ok( 'WantsMoose', 'foo' ); |
30 | } |
31 | |
32 | BEGIN{ MooseX::Empty->unimport();} |
33 | } |
34 | |
35 | { |
36 | ok( ! WantsMoose->can('has'), 'WantsMoose::has() has been cleaned' ); |
37 | ok( ! WantsMoose->can('with'), 'WantsMoose::with() has been cleaned' ); |
38 | can_ok( 'WantsMoose', 'foo' ); |
42c391b1 |
39 | |
40 | # This makes sure that Moose->init_meta() happens properly |
41 | isa_ok( WantsMoose->meta(), 'Moose::Meta::Class' ); |
42 | isa_ok( WantsMoose->new(), 'Moose::Object' ); |
43 | |
4403da90 |
44 | } |
45 | |
46 | { |
47 | package MooseX::Sugar; |
48 | |
49 | use Moose (); |
50 | |
51 | sub wrapped1 { |
52 | my $caller = shift; |
53 | return $caller . ' called wrapped1'; |
54 | } |
55 | |
56 | BEGIN { |
57 | Moose::Exporter->build_import_methods( |
58 | with_caller => ['wrapped1'], |
59 | also => 'Moose', |
60 | ); |
61 | } |
62 | } |
63 | |
64 | { |
65 | package WantsSugar; |
66 | |
67 | BEGIN { MooseX::Sugar->import() } |
68 | |
69 | sub foo { 1 } |
70 | |
71 | BEGIN { |
72 | ::can_ok( 'WantsSugar', 'has' ); |
73 | ::can_ok( 'WantsSugar', 'with' ); |
74 | ::can_ok( 'WantsSugar', 'wrapped1' ); |
75 | ::can_ok( 'WantsSugar', 'foo' ); |
76 | ::is( wrapped1(), 'WantsSugar called wrapped1', |
77 | 'wrapped1 identifies the caller correctly' ); |
78 | } |
79 | |
80 | BEGIN{ MooseX::Sugar->unimport();} |
81 | } |
82 | |
83 | { |
84 | ok( ! WantsSugar->can('has'), 'WantsSugar::has() has been cleaned' ); |
85 | ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' ); |
86 | ok( ! WantsSugar->can('wrapped1'), 'WantsSugar::wrapped1() has been cleaned' ); |
87 | can_ok( 'WantsSugar', 'foo' ); |
88 | } |
89 | |
90 | { |
91 | package MooseX::MoreSugar; |
92 | |
93 | use Moose (); |
94 | |
95 | sub wrapped2 { |
96 | my $caller = shift; |
97 | return $caller . ' called wrapped2'; |
98 | } |
99 | |
100 | sub as_is1 { |
101 | return 'as_is1'; |
102 | } |
103 | |
104 | BEGIN { |
105 | Moose::Exporter->build_import_methods( |
106 | with_caller => ['wrapped2'], |
107 | as_is => ['as_is1'], |
108 | also => 'MooseX::Sugar', |
109 | ); |
110 | } |
111 | } |
112 | |
113 | { |
114 | package WantsMoreSugar; |
115 | |
116 | BEGIN { MooseX::MoreSugar->import() } |
117 | |
118 | sub foo { 1 } |
119 | |
120 | BEGIN { |
121 | ::can_ok( 'WantsMoreSugar', 'has' ); |
122 | ::can_ok( 'WantsMoreSugar', 'with' ); |
123 | ::can_ok( 'WantsMoreSugar', 'wrapped1' ); |
124 | ::can_ok( 'WantsMoreSugar', 'wrapped2' ); |
125 | ::can_ok( 'WantsMoreSugar', 'as_is1' ); |
126 | ::can_ok( 'WantsMoreSugar', 'foo' ); |
127 | ::is( wrapped1(), 'WantsMoreSugar called wrapped1', |
128 | 'wrapped1 identifies the caller correctly' ); |
129 | ::is( wrapped2(), 'WantsMoreSugar called wrapped2', |
130 | 'wrapped2 identifies the caller correctly' ); |
131 | ::is( as_is1(), 'as_is1', |
132 | 'as_is1 works as expected' ); |
133 | } |
134 | |
135 | BEGIN{ MooseX::MoreSugar->unimport();} |
136 | } |
137 | |
138 | { |
139 | ok( ! WantsMoreSugar->can('has'), 'WantsMoreSugar::has() has been cleaned' ); |
140 | ok( ! WantsMoreSugar->can('with'), 'WantsMoreSugar::with() has been cleaned' ); |
141 | ok( ! WantsMoreSugar->can('wrapped1'), 'WantsMoreSugar::wrapped1() has been cleaned' ); |
142 | ok( ! WantsMoreSugar->can('wrapped2'), 'WantsMoreSugar::wrapped2() has been cleaned' ); |
143 | ok( ! WantsMoreSugar->can('as_is1'), 'WantsMoreSugar::as_is1() has been cleaned' ); |
144 | can_ok( 'WantsMoreSugar', 'foo' ); |
145 | } |
146 | |
147 | { |
085fba61 |
148 | package My::Metaclass; |
149 | use Moose; |
150 | BEGIN { extends 'Moose::Meta::Class' } |
151 | |
152 | package My::Object; |
153 | use Moose; |
154 | BEGIN { extends 'Moose::Object' } |
155 | |
156 | package HasInitMeta; |
157 | |
158 | use Moose (); |
159 | |
160 | sub init_meta { |
161 | shift; |
162 | return Moose->init_meta( @_, |
163 | metaclass => 'My::Metaclass', |
164 | base_class => 'My::Object', |
165 | ); |
166 | } |
167 | |
168 | BEGIN { Moose::Exporter->build_import_methods( also => 'Moose' ); } |
169 | } |
170 | |
171 | { |
172 | package NewMeta; |
173 | |
174 | BEGIN { HasInitMeta->import() } |
175 | } |
176 | |
177 | { |
178 | isa_ok( NewMeta->meta(), 'My::Metaclass' ); |
179 | isa_ok( NewMeta->new(), 'My::Object' ); |
180 | } |
181 | |
182 | { |
4403da90 |
183 | package MooseX::CircularAlso; |
184 | |
185 | use Moose (); |
186 | |
187 | ::dies_ok( |
188 | sub { |
189 | Moose::Exporter->build_import_methods( |
190 | also => [ 'Moose', 'MooseX::CircularAlso' ], |
191 | ); |
192 | }, |
193 | 'a circular reference in also dies with an error' |
194 | ); |
195 | |
196 | ::like( |
197 | $@, |
198 | qr/\QCircular reference in also parameter to MooseX::Exporter between MooseX::CircularAlso and MooseX::CircularAlso/, |
199 | 'got the expected error from circular reference in also' |
200 | ); |
201 | } |
202 | |
203 | { |
204 | package MooseX::CircularAlso; |
205 | |
206 | use Moose (); |
207 | |
208 | ::dies_ok( |
209 | sub { |
210 | Moose::Exporter->build_import_methods( |
211 | also => [ 'NoSuchThing' ], |
212 | ); |
213 | }, |
214 | 'a package which does not use Moose::Exporter in also dies with an error' |
215 | ); |
216 | |
217 | ::like( |
218 | $@, |
219 | qr/\QPackage in also (NoSuchThing) does not seem to use MooseX::Exporter/, |
220 | 'got the expected error from a reference in also to a package which does not use Moose::Exporter' |
221 | ); |
222 | } |