Commit | Line | Data |
6aaee015 |
1 | ### make sure we can find our conf.pl file |
2 | BEGIN { |
3 | use FindBin; |
4 | require "$FindBin::Bin/inc/conf.pl"; |
5 | } |
6 | |
7 | ### dummy class for testing dist api ### |
8 | BEGIN { |
9 | |
10 | package CPANPLUS::Dist::_Test; |
11 | use strict; |
12 | use vars qw[$Available $Create $Install $Init $Prepare @ISA]; |
13 | |
14 | @ISA = qw[CPANPLUS::Dist]; |
15 | $Available = 1; |
16 | $Create = 1; |
17 | $Install = 1; |
18 | $Init = 1; |
19 | $Prepare = 1; |
20 | |
21 | require CPANPLUS::Dist; |
22 | CPANPLUS::Dist->_add_dist_types( __PACKAGE__ ); |
23 | |
24 | sub init { $_[0]->status->mk_accessors( |
25 | qw[prepared created installed |
26 | _prepare_args _install_args _create_args]); |
27 | return $Init }; |
28 | sub format_available { return $Available } |
983ffab6 |
29 | sub prepare { return shift->status->prepared( $Prepare ) } |
30 | sub create { return shift->status->created( $Create ) } |
31 | sub install { return shift->status->installed( $Install ) } |
6aaee015 |
32 | } |
33 | |
34 | use strict; |
35 | |
36 | use CPANPLUS::Configure; |
37 | use CPANPLUS::Backend; |
38 | use CPANPLUS::Internals::Constants; |
39 | |
40 | use Test::More 'no_plan'; |
41 | use Cwd; |
42 | use Data::Dumper; |
43 | use File::Basename (); |
44 | use File::Spec (); |
45 | use Module::Load::Conditional qw[check_install]; |
46 | |
47 | my $conf = gimme_conf(); |
48 | my $cb = CPANPLUS::Backend->new( $conf ); |
49 | |
6aaee015 |
50 | ### obsolete |
51 | #my $Format = '_test'; |
52 | my $Module = 'CPANPLUS::Dist::_Test'; |
53 | my $ModName = TEST_CONF_MODULE; |
54 | my $ModPrereq = TEST_CONF_INST_MODULE; |
55 | ### XXX this version doesn't exist, but we don't check for it either ### |
56 | my $Prereq = { $ModPrereq => '1000' }; |
57 | |
58 | ### since it's in this file, not in it's own module file, |
59 | ### make M::L::C think it already was loaded |
60 | $Module::Load::Conditional::CACHE->{$Module}->{usable} = 1; |
61 | |
62 | |
63 | use_ok('CPANPLUS::Dist'); |
64 | |
65 | ### start with fresh sources ### |
66 | ok( $cb->reload_indices( update_source => 0 ), |
67 | "Rebuilding trees" ); |
68 | |
69 | my $Mod = $cb->module_tree( $ModName ); |
70 | ok( $Mod, "Got module object" ); |
71 | |
72 | |
73 | ### straight forward dist build - prepare, create, install |
74 | { my $dist = CPANPLUS::Dist->new( |
75 | format => $Module, |
76 | module => $Mod |
77 | ); |
78 | |
79 | ok( $dist, "New dist object created" ); |
80 | isa_ok( $dist, 'CPANPLUS::Dist' ); |
81 | isa_ok( $dist, $Module ); |
82 | |
83 | my $status = $dist->status; |
84 | ok( $status, "Status object found" ); |
85 | isa_ok( $status, "Object::Accessor" ); |
86 | |
87 | ok( $dist->prepare, "Prepare call" ); |
88 | ok( $dist->status->prepared," Status registered OK" ); |
89 | |
90 | ok( $dist->create, "Create call" ); |
91 | ok( $dist->status->created, " Status registered OK" ); |
92 | |
93 | ok( $dist->install, "Install call" ); |
94 | ok( $dist->status->installed, |
95 | " Status registered OK" ); |
96 | } |
97 | |
98 | ### check 'sanity check' option ### |
99 | { local $CPANPLUS::Dist::_Test::Available = 0; |
100 | |
101 | ok( !$Module->format_available, |
102 | "Format availabillity turned off" ); |
103 | |
104 | { $conf->_set_build('sanity_check' => 0); |
105 | |
106 | my $dist = CPANPLUS::Dist->new( |
107 | format => $Module, |
108 | module => $Mod |
109 | ); |
110 | |
111 | ok( $dist, "Dist created with sanity check off" ); |
112 | isa_ok( $dist, $Module ); |
113 | |
114 | } |
115 | |
116 | { $conf->_set_build('sanity_check' => 1); |
117 | my $dist = CPANPLUS::Dist->new( |
118 | format => $Module, |
119 | module => $Mod |
120 | ); |
121 | |
122 | ok( !$dist, "Dist not created with sanity check on" ); |
123 | like( CPANPLUS::Error->stack_as_string, |
124 | qr/Format '$Module' is not available/, |
125 | " Error recorded as expected" ); |
126 | } |
127 | } |
128 | |
129 | ### undef the status hash, make sure it complains ### |
130 | { local $CPANPLUS::Dist::_Test::Init = 0; |
131 | |
132 | my $dist = CPANPLUS::Dist->new( |
133 | format => $Module, |
134 | module => $Mod |
135 | ); |
136 | |
137 | ok( !$dist, "No dist created by failed init" ); |
138 | like( CPANPLUS::Error->stack_as_string, |
139 | qr/Dist initialization of '$Module' failed for/s, |
140 | " Error recorded as expected" ); |
141 | } |
142 | |
143 | ### test _resolve prereqs, in a somewhat simulated set of circumstances |
144 | { my $old_prereq = $conf->get_conf('prereqs'); |
145 | |
146 | my $map = { |
147 | 0 => { |
148 | 'Previous install failed' => [ |
149 | sub { $cb->module_tree($ModPrereq)->status->installed(0); |
150 | 'install' }, |
151 | sub { like( CPANPLUS::Error->stack_as_string, |
152 | qr/failed to install before in this session/s, |
153 | " Previous install failed recorded ok" ) }, |
154 | ], |
155 | |
156 | "Set $Module->prepare to false" => [ |
157 | sub { $CPANPLUS::Dist::_Test::Prepare = 0; 'install' }, |
158 | sub { like( CPANPLUS::Error->stack_as_string, |
159 | qr/Unable to create a new distribution object/s, |
160 | " Dist creation failed recorded ok" ) }, |
161 | sub { like( CPANPLUS::Error->stack_as_string, |
162 | qr/Failed to install '$ModPrereq' as prerequisite/s, |
163 | " Dist creation failed recorded ok" ) }, |
164 | ], |
165 | |
166 | "Set $Module->create to false" => [ |
167 | sub { $CPANPLUS::Dist::_Test::Create = 0; 'install' }, |
168 | sub { like( CPANPLUS::Error->stack_as_string, |
169 | qr/Unable to create a new distribution object/s, |
170 | " Dist creation failed recorded ok" ) }, |
171 | sub { like( CPANPLUS::Error->stack_as_string, |
172 | qr/Failed to install '$ModPrereq' as prerequisite/s, |
173 | " Dist creation failed recorded ok" ) }, |
174 | ], |
175 | |
176 | "Set $Module->install to false" => [ |
177 | sub { $CPANPLUS::Dist::_Test::Install = 0; 'install' }, |
178 | sub { like( CPANPLUS::Error->stack_as_string, |
179 | qr/Failed to install '$ModPrereq' as/s, |
180 | " Dist installation failed recorded ok" ) }, |
181 | ], |
182 | |
183 | "Set dependency to be perl-core" => [ |
184 | sub { $cb->module_tree( $ModPrereq )->package( |
185 | 'perl-5.8.1.tar.gz' ); 'install' }, |
186 | sub { like( CPANPLUS::Error->stack_as_string, |
187 | qr/Prerequisite '$ModPrereq' is perl-core/s, |
188 | " Dist installation failed recorded ok" ) }, |
189 | ], |
190 | 'Simple ignore' => [ |
191 | sub { 'ignore' }, |
192 | sub { ok( !$_[0]->status->prepared, |
193 | " Module status says not prepared" ) }, |
194 | sub { ok( !$_[0]->status->created, |
195 | " Module status says not created" ) }, |
196 | sub { ok( !$_[0]->status->installed, |
197 | " Module status says not installed" ) }, |
198 | ], |
199 | 'Ignore from conf' => [ |
200 | sub { $conf->set_conf(prereqs => PREREQ_IGNORE); '' }, |
201 | sub { ok( !$_[0]->status->prepared, |
202 | " Module status says not prepared" ) }, |
203 | sub { ok( !$_[0]->status->created, |
204 | " Module status says not created" ) }, |
205 | sub { ok( !$_[0]->status->installed, |
206 | " Module status says not installed" ) }, |
207 | ### set the conf back ### |
208 | sub { $conf->set_conf(prereqs => PREREQ_INSTALL); }, |
209 | ], |
210 | }, |
211 | 1 => { |
212 | 'Simple create' => [ |
213 | sub { 'create' }, |
214 | sub { ok( $_[0]->status->prepared, |
215 | " Module status says prepared" ) }, |
216 | sub { ok( $_[0]->status->created, |
217 | " Module status says created" ) }, |
218 | sub { ok( !$_[0]->status->installed, |
219 | " Module status says not installed" ) }, |
220 | ], |
221 | 'Simple install' => [ |
222 | sub { 'install' }, |
223 | sub { ok( $_[0]->status->prepared, |
224 | " Module status says prepared" ) }, |
225 | sub { ok( $_[0]->status->created, |
226 | " Module status says created" ) }, |
227 | sub { ok( $_[0]->status->installed, |
228 | " Module status says installed" ) }, |
229 | ], |
230 | |
231 | 'Install from conf' => [ |
232 | sub { $conf->set_conf(prereqs => PREREQ_INSTALL); '' }, |
233 | sub { ok( $_[0]->status->prepared, |
234 | " Module status says prepared" ) }, |
235 | sub { ok( $_[0]->status->created, |
236 | " Module status says created" ) }, |
237 | sub { ok( $_[0]->status->installed, |
238 | " Module status says installed" ) }, |
239 | ], |
240 | 'Create from conf' => [ |
241 | sub { $conf->set_conf(prereqs => PREREQ_BUILD); '' }, |
242 | sub { ok( $_[0]->status->prepared, |
243 | " Module status says prepared" ) }, |
244 | sub { ok( $_[0]->status->created, |
245 | " Module status says created" ) }, |
246 | sub { ok( !$_[0]->status->installed, |
247 | " Module status says not installed" ) }, |
248 | ### set the conf back ### |
249 | sub { $conf->set_conf(prereqs => PREREQ_INSTALL); }, |
250 | ], |
251 | |
252 | 'Ask from conf' => [ |
253 | sub { $cb->_register_callback( |
254 | name => 'install_prerequisite', |
255 | code => sub {1} ); |
256 | $conf->set_conf(prereqs => PREREQ_ASK); '' }, |
257 | sub { ok( $_[0]->status->prepared, |
258 | " Module status says prepared" ) }, |
259 | sub { ok( $_[0]->status->created, |
260 | " Module status says created" ) }, |
261 | sub { ok( $_[0]->status->installed, |
262 | " Module status says installed" ) }, |
263 | ### set the conf back ### |
264 | sub { $conf->set_conf(prereqs => PREREQ_INSTALL); }, |
265 | |
266 | ], |
267 | |
268 | 'Ask from conf, but decline' => [ |
269 | sub { $cb->_register_callback( |
270 | name => 'install_prerequisite', |
271 | code => sub {0} ); |
272 | $conf->set_conf( prereqs => PREREQ_ASK); '' }, |
273 | sub { ok( !$_[0]->status->installed, |
274 | " Module status says not installed" ) }, |
275 | sub { like( CPANPLUS::Error->stack_as_string, |
276 | qr/Will not install prerequisite '$ModPrereq' -- Note/, |
277 | " Install skipped, recorded ok" ) }, |
278 | ### set the conf back ### |
279 | sub { $conf->set_conf(prereqs => PREREQ_INSTALL); }, |
280 | ], |
281 | |
282 | "Set recursive dependency" => [ |
283 | sub { $cb->_status->pending_prereqs({ $ModPrereq => 1 }); |
284 | 'install' }, |
285 | sub { like( CPANPLUS::Error->stack_as_string, |
286 | qr/Recursive dependency detected/, |
287 | " Recursive dependency recorded ok" ) }, |
288 | ], |
289 | |
290 | }, |
291 | }; |
292 | |
293 | for my $bool ( sort keys %$map ) { |
294 | |
295 | diag("Running ". ($bool?'success':'fail') . " tests") if @ARGV; |
296 | |
297 | my $href = $map->{$bool}; |
298 | while ( my($txt,$aref) = each %$href ) { |
299 | |
300 | ### reset everything ### |
301 | ok( $cb->reload_indices( update_source => 0 ), |
302 | "Rebuilding trees" ); |
303 | |
304 | $CPANPLUS::Dist::_Test::Available = 1; |
305 | $CPANPLUS::Dist::_Test::Prepare = 1; |
306 | $CPANPLUS::Dist::_Test::Create = 1; |
307 | $CPANPLUS::Dist::_Test::Install = 1; |
308 | |
309 | CPANPLUS::Error->flush; |
310 | $cb->_status->mk_flush; |
311 | |
312 | ### get a new dist from Text::Bastardize ### |
313 | my $dist = CPANPLUS::Dist->new( |
314 | format => $Module, |
315 | module => $cb->module_tree( $ModName ), |
316 | ); |
317 | |
318 | ### first sub returns target ### |
319 | my $sub = shift @$aref; |
320 | my $target = $sub->(); |
321 | |
322 | my $flag = $dist->_resolve_prereqs( |
323 | format => $Module, |
324 | force => 1, |
325 | target => $target, |
326 | prereqs => $Prereq ); |
327 | |
328 | is( !!$flag, !!$bool, $txt ); |
329 | |
330 | ### any extra tests ### |
331 | $_->($cb->module_tree($ModPrereq)) for @$aref; |
332 | |
333 | } |
334 | } |
335 | } |
336 | |
337 | |
338 | ### prereq satisfied tests |
339 | { my $map = { |
340 | # version regex |
341 | 0 => undef, |
342 | 1 => undef, |
343 | 2 => qr/have to resolve/, |
344 | }; |
345 | |
346 | my $mod = CPANPLUS::Module::Fake->new( |
347 | module => $$, |
348 | package => $$, |
349 | path => $$, |
350 | version => 1 ); |
351 | |
352 | ok( $mod, "Fake module created" ); |
353 | is( $mod->version, 1, " Version set correctly" ); |
354 | |
355 | my $dist = CPANPLUS::Dist->new( |
356 | format => $Module, |
357 | module => $Mod |
358 | ); |
359 | |
360 | ok( $dist, "Dist object created" ); |
361 | isa_ok( $dist, $Module ); |
362 | |
363 | |
364 | ### scope it for the locals |
365 | { local $^W; # quell sub redefined warnings; |
366 | |
367 | ### is_uptodate will need to return false for this test |
368 | local *CPANPLUS::Module::Fake::is_uptodate = sub { return }; |
369 | local *CPANPLUS::Module::Fake::is_uptodate = sub { return }; |
370 | CPANPLUS::Error->flush; |
371 | |
372 | |
373 | ### it's satisfied |
374 | while( my($ver, $re) = each %$map ) { |
375 | |
376 | my $rv = $dist->prereq_satisfied( |
377 | version => $ver, |
378 | modobj => $mod ); |
379 | |
380 | ok( 1, "Testing ver: $ver" ); |
381 | is( $rv, undef, " Return value as expected" ); |
382 | |
383 | if( $re ) { |
384 | like( CPANPLUS::Error->stack_as_string, $re, |
385 | " Error as expected" ); |
386 | } |
387 | |
388 | CPANPLUS::Error->flush; |
389 | } |
390 | } |
391 | } |
392 | |
393 | |
394 | ### dist_types tests |
395 | { can_ok( 'CPANPLUS::Dist', 'dist_types' ); |
396 | |
397 | SKIP: { |
398 | skip "You do not have Module::Pluggable installed", 2 |
399 | unless check_install( module => 'Module::Pluggable' ); |
400 | |
401 | my @types = CPANPLUS::Dist->dist_types; |
402 | ok( scalar(@types), " Dist types found" ); |
403 | ok( grep( /_Test/, @types), " Found our _Test dist type" ); |
404 | } |
405 | } |
406 | 1; |
407 | |
408 | # Local variables: |
409 | # c-indentation-style: bsd |
410 | # c-basic-offset: 4 |
411 | # indent-tabs-mode: nil |
412 | # End: |
413 | # vim: expandtab shiftwidth=4: |