[perl #43425] local $[: fix scoping during parser error handling.
[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 }
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
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
6aaee015 50### obsolete
51#my $Format = '_test';
52my $Module = 'CPANPLUS::Dist::_Test';
53my $ModName = TEST_CONF_MODULE;
54my $ModPrereq = TEST_CONF_INST_MODULE;
55### XXX this version doesn't exist, but we don't check for it either ###
56my $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
63use_ok('CPANPLUS::Dist');
64
65### start with fresh sources ###
66ok( $cb->reload_indices( update_source => 0 ),
67 "Rebuilding trees" );
68
69my $Mod = $cb->module_tree( $ModName );
70ok( $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}
4061;
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: