1 ### make sure we can find our conf.pl file
4 require "$FindBin::Bin/inc/conf.pl";
9 use CPANPLUS::Configure;
10 use CPANPLUS::Backend;
12 use CPANPLUS::Dist::MM;
13 use CPANPLUS::Internals::Constants;
15 use Test::More 'no_plan';
19 use File::Basename ();
22 my $conf = gimme_conf();
23 my $cb = CPANPLUS::Backend->new( $conf );
24 my $noperms = ($< and not $conf->get_program('sudo')) &&
25 ($conf->get_conf('makemakerflags') or
26 not -w $Config{installsitelib} );
28 my $Verbose = @ARGV ? 1 : 0;
30 #$IPC::Cmd::DEBUG = $Verbose;
32 ### Make sure we get the _EUMM_NOXS_ version
33 my $ModName = TEST_CONF_MODULE;
35 ### This is the module name that gets /installed/
36 my $InstName = TEST_CONF_INST_MODULE;
38 ### don't start sending test reports now... ###
39 $cb->_callbacks->send_test_report( sub { 0 } );
40 $conf->set_conf( cpantest => 0 );
42 ### Redirect errors to file ###
43 *STDERR = output_handle() unless $Verbose;
45 ### dont uncomment this, it screws up where STDOUT goes and makes
46 ### test::harness create test counter mismatches
47 #*STDOUT = output_handle() unless @ARGV;
48 ### for the same test-output counter mismatch, we disable verbose
50 $conf->set_conf( verbose => $Verbose );
51 $conf->set_conf( allow_build_interactivity => 0 );
53 ### start with fresh sources ###
54 ok( $cb->reload_indices( update_source => 0 ),
57 ### we might need this Some Day when we're going to install into
58 ### our own sandbox dir.. but for now, no dice due to EU::I bug
59 # $conf->set_program( sudo => '' );
60 # $conf->set_conf( makemakerflags => TEST_INSTALL_EU_MM_FLAGS );
62 ### set alternate install dir ###
63 ### XXX rather pointless, since we can't uninstall them, due to a bug
64 ### in EU::Installed (6871). And therefor we can't test uninstall() or any of
65 ### the EU::Installed functions. So, let's just install into sitelib... =/
66 #my $prefix = File::Spec->rel2abs( File::Spec->catdir(cwd(),'dummy-perl') );
67 #my $rv = $cb->configure_object->set_conf( makemakerflags => "PREFIX=$prefix" );
68 #ok( $rv, "Alternate install path set" );
70 my $Mod = $cb->module_tree( $ModName );
71 my $InstMod = $cb->module_tree( $InstName );
72 ok( $Mod, "Loaded object for: " . $Mod->name );
73 ok( $Mod, "Loaded object for: " . $InstMod->name );
75 ### format_available tests ###
76 { ok( CPANPLUS::Dist::MM->format_available,
77 "Format is available" );
81 local *CPANPLUS::Dist::MM::can_load = sub { 0 };
82 ok(!CPANPLUS::Dist::MM->format_available,
83 " Making format unavailable" );
86 ### test if the error got logged ok ###
87 like( CPANPLUS::Error->stack_as_string,
88 qr/You do not have .+?'CPANPLUS::Dist::MM' not available/s,
89 " Format failure logged" );
91 ### flush the stack ###
92 CPANPLUS::Error->flush;
95 ok( $Mod->fetch, "Fetching module to ".$Mod->status->fetch );
96 ok( $Mod->extract, "Extracting module to ".$Mod->status->extract );
98 ok( $Mod->test, "Testing module" );
100 ok( $Mod->status->dist_cpan->status->test,
101 " Test success registered as status" );
102 ok( $Mod->status->dist_cpan->status->prepared,
103 " Prepared status registered" );
104 ok( $Mod->status->dist_cpan->status->created,
105 " Created status registered" );
106 is( $Mod->status->dist_cpan->status->distdir, $Mod->status->extract,
107 " Distdir status registered properly" );
109 ### test the convenience methods
110 ok( $Mod->prepare, "Preparing module" );
111 ok( $Mod->create, "Creating module" );
113 ok( $Mod->dist, "Building distribution" );
114 ok( $Mod->status->dist_cpan, " Dist registered as status" );
115 isa_ok( $Mod->status->dist_cpan, "CPANPLUS::Dist::MM" );
117 ### flush the lib cache
118 ### otherwise, cpanplus thinks the module's already installed
119 ### since the blib is already in @INC
120 $cb->_flush( list => [qw|lib|] );
124 skip(q[No install tests under core perl], 10) if $ENV{PERL_CORE};
126 skip(q[Probably no permissions to install, skipping], 10)
129 ### XXX new EU::I should be forthcoming pending this patch from Steffen
130 ### Mueller on p5p: http://www.xray.mpe.mpg.de/mailing-lists/ \
131 ### perl5-porters/2007-01/msg00895.html
132 ### This should become EU::I 1.42.. if so, we should upgrade this bit of
133 ### code and remove the diag, since we can then install in our dummy dir..
134 diag("\nSorry, installing into your real perl dir, rather than our test");
135 diag("area since ExtUtils::Installed does not probe for .packlists in " );
136 diag('other dirs than those in %Config. See bug #6871 on rt.cpan.org ' );
139 diag(q[Note: 'sudo' might ask for your password to do the install test])
140 if $conf->get_program('sudo');
142 ### make sure no options are set in PERL5_MM_OPT, as they might
143 ### change the installation target and therefor will 1. mess up
144 ### the tests and 2. leave an installed copy of our test module
145 ### lying around. This addresses bug #29716: 20_CPANPLUS-Dist-MM.t
146 ### fails (and leaves test files installed) when EUMM options
147 ### include INSTALL_BASE
148 { local $ENV{'PERL5_MM_OPT'};
150 ok( $Mod->install( force =>1 ),
151 "Installing module" );
154 ok( $Mod->status->installed," Module installed according to status" );
157 SKIP: { ### EU::Installed tests ###
159 skip("makemakerflags set -- probably EU::Installed tests will fail", 8)
160 if $conf->get_conf('makemakerflags');
162 skip( "Old perl on cygwin detected " .
163 "-- tests will fail due to known bugs", 8
166 ### might need it Later when EU::I is fixed..
167 #local @INC = ( TEST_INSTALL_DIR_LIB, @INC );
170 my @missing = $InstMod->validate;
172 is_deeply( \@missing, [],
173 "No missing files" );
177 my @files = $InstMod->files;
179 ### number of files may vary from OS to OS
180 ok( scalar(@files), "All files accounted for" );
181 ok( grep( /$File/, @files),
182 " Found the module" );
184 ### XXX does this work on all OSs?
185 #ok( grep( /man/, @files ),
186 # " Found the manpage" );
190 my ($obj) = $InstMod->packlist;
191 isa_ok( $obj, "ExtUtils::Packlist" );
195 my @dirs = $InstMod->directory_tree;
196 ok( scalar(@dirs), "Directory tree obtained" );
199 for my $dir (@dirs) {
200 ok( -d $dir, " Directory exists" );
202 my $file = File::Spec->catfile( $dir, $File );
203 $found = $file if -e $file;
206 ok( -e $found, " Module found" );
210 skip("Probably no permissions to uninstall", 1)
213 ok( $InstMod->uninstall,"Uninstalling module" );
218 ### test exceptions in Dist::MM->create ###
219 { ok( $Mod->status->mk_flush, "Old status info flushed" );
220 my $dist = CPANPLUS::Dist->new( module => $Mod,
221 format => INSTALLER_MM );
223 ok( $dist, "New dist object made" );
224 ok(!$dist->prepare, " Dist->prepare failed" );
225 like( CPANPLUS::Error->stack_as_string, qr/No dir found to operate on/,
228 ### manually set the extract dir,
229 $Mod->status->extract($0);
231 ok(!$dist->create, " Dist->create failed" );
232 like( CPANPLUS::Error->stack_as_string, qr/not successfully prepared/s,
235 ### pretend we've been prepared ###
236 $dist->status->prepared(1);
238 ok(!$dist->create, " Dist->create failed" );
239 like( CPANPLUS::Error->stack_as_string, qr/Could not chdir/s,
243 ### writemakefile.pl tests ###
244 { ### remove old status info
245 ok( $Mod->status->mk_flush, "Old status info flushed" );
246 ok( $Mod->fetch, "Module fetched again" );
247 ok( $Mod->extract, "Module extracted again" );
249 ### cheat and add fake prereqs ###
250 my $prereq = TEST_CONF_PREREQ;
252 $Mod->status->prereqs( { $prereq => 0 } );
254 my $makefile_pl = MAKEFILE_PL->( $Mod->status->extract );
255 my $makefile = MAKEFILE->( $Mod->status->extract );
257 my $dist = $Mod->dist;
258 ok( $dist, "Dist object built" );
260 ### check for a makefile.pl and 'write' one
261 ok( -s $makefile_pl, " Makefile.PL present" );
262 ok( $dist->write_makefile_pl( force => 0 ),
263 " Makefile.PL written" );
264 like( CPANPLUS::Error->stack_as_string, qr/Already created/,
265 " Prior existance noted" );
267 ### ok, unlink the makefile.pl, now really write one
268 1 while unlink $makefile;
270 ### must do '1 while' for VMS
271 { my $unlink_sts = unlink($makefile_pl);
272 1 while unlink $makefile_pl;
273 ok( $unlink_sts, "Deleting Makefile.PL");
276 ok( !-s $makefile_pl, " Makefile.PL deleted" );
277 ok( !-s $makefile, " Makefile deleted" );
278 ok($dist->write_makefile_pl," Makefile.PL written" );
280 ### see if we wrote anything sensible
281 my $fh = OPEN_FILE->( $makefile_pl );
282 ok( $fh, "Makefile.PL open for read" );
284 my $str = do { local $/; <$fh> };
285 like( $str, qr/### Auto-generated .+ by CPANPLUS ###/,
286 " Autogeneration noted" );
287 like( $str, '/'. $Mod->module .'/',
288 " Contains module name" );
289 like( $str, '/'. quotemeta($Mod->version) . '/',
290 " Contains version" );
291 like( $str, '/'. $Mod->author->author .'/',
292 " Contains author" );
293 like( $str, '/PREREQ_PM/', " Contains prereqs" );
294 like( $str, qr/$prereq.+0/, " Contains prereqs" );
298 ### seems ok, now delete it again and go via install()
299 ### to see if it picks up on the missing makefile.pl and
300 ### does the right thing
301 ### must do '1 while' for VMS
302 { my $unlink_sts = unlink($makefile_pl);
303 1 while unlink $makefile_pl;
304 ok( $unlink_sts, "Deleting Makefile.PL");
306 ok( !-s $makefile_pl, " Makefile.PL deleted" );
307 ok( $dist->status->mk_flush,"Dist status flushed" );
308 ok( $dist->prepare, " Dist->prepare run again" );
309 ok( $dist->create, " Dist->create run again" );
310 ok( -s $makefile_pl, " Makefile.PL present" );
311 like( CPANPLUS::Error->stack_as_string,
312 qr/attempting to generate one/,
313 " Makefile.PL generation attempt logged" );
315 ### now let's throw away the makefile.pl, flush the status and not
316 ### write a makefile.pl
318 local *CPANPLUS::Dist::MM::write_makefile_pl = sub { 1 };
320 1 while unlink $makefile_pl;
321 1 while unlink $makefile;
323 ok(!-s $makefile_pl, "Makefile.PL deleted" );
324 ok(!-s $makefile, "Makefile deleted" );
325 ok( $dist->status->mk_flush,"Dist status flushed" );
326 ok(!$dist->prepare, " Dist->prepare failed" );
327 like( CPANPLUS::Error->stack_as_string,
328 qr/Could not find 'Makefile.PL'/i,
329 " Missing Makefile.PL noted" );
330 is( $dist->status->makefile, 0,
331 " Did not manage to create Makefile" );
334 ### now let's write a makefile.pl that just does 'die'
336 local *CPANPLUS::Dist::MM::write_makefile_pl =
337 __PACKAGE__->_custom_makefile_pl_sub( "exit 1;" );
339 ### there's no makefile.pl now, since the previous test failed
341 #ok( -e $makefile_pl, "Makefile.PL exists" );
342 #ok( unlink($makefile_pl), " Deleting Makefile.PL");
343 ok(!-s $makefile_pl, "Makefile.PL deleted" );
344 ok( $dist->status->mk_flush,"Dist status flushed" );
345 ok(!$dist->prepare, " Dist->prepare failed" );
346 like( CPANPLUS::Error->stack_as_string, qr/Could not run/s,
347 " Logged failed 'perl Makefile.PL'" );
348 is( $dist->status->makefile, 0,
349 " Did not manage to create Makefile" );
352 ### clean up afterwards ###
353 ### must do '1 while' for VMS
354 { my $unlink_sts = unlink($makefile_pl);
355 1 while unlink $makefile_pl;
356 ok( $unlink_sts, "Deleting Makefile.PL");
359 $dist->status->mk_flush;
362 ### test ENV setting in Makefile.PL
363 { ### use print() not die() -- we're redirecting STDERR in tests!
364 my $env = ENV_CPANPLUS_IS_EXECUTING;
365 my $sub = __PACKAGE__->_custom_makefile_pl_sub(
366 "print qq[ENV=\$ENV{$env}\n]; exit 1;" );
368 my $clone = $Mod->clone;
369 $clone->status->fetch( $Mod->status->fetch );
371 ok( $clone, 'Testing ENV settings $dist->prepare' );
372 ok( $clone->extract, ' Files extracted' );
373 ok( $clone->prepare, ' $mod->prepare worked first time' );
375 my $dist = $clone->status->dist;
376 my $makefile_pl = MAKEFILE_PL->( $clone->status->extract );
378 ok( $sub->($dist), " Custom Makefile.PL written" );
379 ok( -e $makefile_pl, " File exists" );
382 CPANPLUS::Error->flush;
384 my $rv = $dist->prepare( force => 1, verbose => 0 );
385 ok( !$rv, ' $dist->prepare failed' );
388 skip( "Can't test ENV{$env} -- no buffers available", 1 )
389 unless IPC::Cmd->can_capture_buffer;
391 my $re = quotemeta( $makefile_pl );
392 like( CPANPLUS::Error->stack_as_string, qr/ENV=$re/,
393 " \$ENV $env set correctly during execution");
396 ### and the ENV var should no longer be set now
397 ok( !$ENV{$env}, " ENV var now unset" );
400 sub _custom_makefile_pl_sub {
402 my $txt = shift or return;
406 my $self = $dist->parent;
407 my $fh = OPEN_FILE->(
408 MAKEFILE_PL->($self->status->extract), '>' );
418 # c-indentation-style: bsd
420 # indent-tabs-mode: nil
422 # vim: expandtab shiftwidth=4: