Silence the warning "Can't locate auto/POSIX/autosplit.ix in @INC"
[p5sagit/p5-mst-13.2.git] / lib / CPANPLUS / t / 19_CPANPLUS-Dist.t
CommitLineData
6aaee015 1### make sure we can find our conf.pl file
2BEGIN {
3 use FindBin;
4 require "$FindBin::Bin/inc/conf.pl";
5}
6
7### dummy class for testing dist api ###
8BEGIN {
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
34use strict;
35
36use CPANPLUS::Configure;
37use CPANPLUS::Backend;
38use CPANPLUS::Internals::Constants;
39
40use Test::More 'no_plan';
41use Cwd;
42use Data::Dumper;
43use File::Basename ();
44use File::Spec ();
45use Module::Load::Conditional qw[check_install];
46
47my $conf = gimme_conf();
48my $cb = CPANPLUS::Backend->new( $conf );
49
50### Redirect errors to file ###
51local $CPANPLUS::Error::ERROR_FH = output_handle() unless @ARGV;
52local $CPANPLUS::Error::MSG_FH = output_handle() unless @ARGV;
53
54### obsolete
55#my $Format = '_test';
56my $Module = 'CPANPLUS::Dist::_Test';
57my $ModName = TEST_CONF_MODULE;
58my $ModPrereq = TEST_CONF_INST_MODULE;
59### XXX this version doesn't exist, but we don't check for it either ###
60my $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
67use_ok('CPANPLUS::Dist');
68
69### start with fresh sources ###
70ok( $cb->reload_indices( update_source => 0 ),
71 "Rebuilding trees" );
72
73my $Mod = $cb->module_tree( $ModName );
74ok( $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}
4101;
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: