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