1 ### make sure we can find our conf.pl file
4 require "$FindBin::Bin/inc/conf.pl";
7 ### dummy class for testing dist api ###
10 package CPANPLUS::Dist::_Test;
12 use vars qw[$Available $Create $Install $Init $Prepare @ISA];
14 @ISA = qw[CPANPLUS::Dist];
21 require CPANPLUS::Dist;
22 CPANPLUS::Dist->_add_dist_types( __PACKAGE__ );
24 sub init { $_[0]->status->mk_accessors(
25 qw[prepared created installed
26 _prepare_args _install_args _create_args]);
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) }
36 use CPANPLUS::Configure;
37 use CPANPLUS::Backend;
38 use CPANPLUS::Internals::Constants;
40 use Test::More 'no_plan';
43 use File::Basename ();
45 use Module::Load::Conditional qw[check_install];
47 my $conf = gimme_conf();
48 my $cb = CPANPLUS::Backend->new( $conf );
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;
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' };
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;
67 use_ok('CPANPLUS::Dist');
69 ### start with fresh sources ###
70 ok( $cb->reload_indices( update_source => 0 ),
73 my $Mod = $cb->module_tree( $ModName );
74 ok( $Mod, "Got module object" );
77 ### straight forward dist build - prepare, create, install
78 { my $dist = CPANPLUS::Dist->new(
83 ok( $dist, "New dist object created" );
84 isa_ok( $dist, 'CPANPLUS::Dist' );
85 isa_ok( $dist, $Module );
87 my $status = $dist->status;
88 ok( $status, "Status object found" );
89 isa_ok( $status, "Object::Accessor" );
91 ok( $dist->prepare, "Prepare call" );
92 ok( $dist->status->prepared," Status registered OK" );
94 ok( $dist->create, "Create call" );
95 ok( $dist->status->created, " Status registered OK" );
97 ok( $dist->install, "Install call" );
98 ok( $dist->status->installed,
99 " Status registered OK" );
102 ### check 'sanity check' option ###
103 { local $CPANPLUS::Dist::_Test::Available = 0;
105 ok( !$Module->format_available,
106 "Format availabillity turned off" );
108 { $conf->_set_build('sanity_check' => 0);
110 my $dist = CPANPLUS::Dist->new(
115 ok( $dist, "Dist created with sanity check off" );
116 isa_ok( $dist, $Module );
120 { $conf->_set_build('sanity_check' => 1);
121 my $dist = CPANPLUS::Dist->new(
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" );
133 ### undef the status hash, make sure it complains ###
134 { local $CPANPLUS::Dist::_Test::Init = 0;
136 my $dist = CPANPLUS::Dist->new(
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" );
147 ### test _resolve prereqs, in a somewhat simulated set of circumstances
148 { my $old_prereq = $conf->get_conf('prereqs');
152 'Previous install failed' => [
153 sub { $cb->module_tree($ModPrereq)->status->installed(0);
155 sub { like( CPANPLUS::Error->stack_as_string,
156 qr/failed to install before in this session/s,
157 " Previous install failed recorded ok" ) },
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" ) },
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" ) },
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" ) },
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" ) },
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" ) },
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); },
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" ) },
225 'Simple 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" ) },
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" ) },
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); },
257 sub { $cb->_register_callback(
258 name => 'install_prerequisite',
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); },
272 'Ask from conf, but decline' => [
273 sub { $cb->_register_callback(
274 name => 'install_prerequisite',
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); },
286 "Set recursive dependency" => [
287 sub { $cb->_status->pending_prereqs({ $ModPrereq => 1 });
289 sub { like( CPANPLUS::Error->stack_as_string,
290 qr/Recursive dependency detected/,
291 " Recursive dependency recorded ok" ) },
297 for my $bool ( sort keys %$map ) {
299 diag("Running ". ($bool?'success':'fail') . " tests") if @ARGV;
301 my $href = $map->{$bool};
302 while ( my($txt,$aref) = each %$href ) {
304 ### reset everything ###
305 ok( $cb->reload_indices( update_source => 0 ),
306 "Rebuilding trees" );
308 $CPANPLUS::Dist::_Test::Available = 1;
309 $CPANPLUS::Dist::_Test::Prepare = 1;
310 $CPANPLUS::Dist::_Test::Create = 1;
311 $CPANPLUS::Dist::_Test::Install = 1;
313 CPANPLUS::Error->flush;
314 $cb->_status->mk_flush;
316 ### get a new dist from Text::Bastardize ###
317 my $dist = CPANPLUS::Dist->new(
319 module => $cb->module_tree( $ModName ),
322 ### first sub returns target ###
323 my $sub = shift @$aref;
324 my $target = $sub->();
326 my $flag = $dist->_resolve_prereqs(
330 prereqs => $Prereq );
332 is( !!$flag, !!$bool, $txt );
334 ### any extra tests ###
335 $_->($cb->module_tree($ModPrereq)) for @$aref;
342 ### prereq satisfied tests
347 2 => qr/have to resolve/,
350 my $mod = CPANPLUS::Module::Fake->new(
356 ok( $mod, "Fake module created" );
357 is( $mod->version, 1, " Version set correctly" );
359 my $dist = CPANPLUS::Dist->new(
364 ok( $dist, "Dist object created" );
365 isa_ok( $dist, $Module );
368 ### scope it for the locals
369 { local $^W; # quell sub redefined warnings;
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;
378 while( my($ver, $re) = each %$map ) {
380 my $rv = $dist->prereq_satisfied(
384 ok( 1, "Testing ver: $ver" );
385 is( $rv, undef, " Return value as expected" );
388 like( CPANPLUS::Error->stack_as_string, $re,
389 " Error as expected" );
392 CPANPLUS::Error->flush;
399 { can_ok( 'CPANPLUS::Dist', 'dist_types' );
402 skip "You do not have Module::Pluggable installed", 2
403 unless check_install( module => 'Module::Pluggable' );
405 my @types = CPANPLUS::Dist->dist_types;
406 ok( scalar(@types), " Dist types found" );
407 ok( grep( /_Test/, @types), " Found our _Test dist type" );
413 # c-indentation-style: bsd
415 # indent-tabs-mode: nil
417 # vim: expandtab shiftwidth=4: