Silence the warning "Can't locate auto/POSIX/autosplit.ix in @INC"
[p5sagit/p5-mst-13.2.git] / lib / CPANPLUS / t / 20_CPANPLUS-Dist-MM.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
7use strict;
8
9use CPANPLUS::Configure;
10use CPANPLUS::Backend;
11use CPANPLUS::Dist;
12use CPANPLUS::Dist::MM;
13use CPANPLUS::Internals::Constants;
14
15use Test::More 'no_plan';
16use Cwd;
17use Config;
18use Data::Dumper;
19use File::Basename ();
20use File::Spec ();
21
22my $conf = gimme_conf();
23my $cb = CPANPLUS::Backend->new( $conf );
24my $noperms = ($< and not $conf->get_program('sudo')) &&
25 ($conf->get_conf('makemakerflags') or
26 not -w $Config{installsitelib} );
27my $File = 'Bar.pm';
28my $Verbose = @ARGV ? 1 : 0;
29
30#$IPC::Cmd::DEBUG = $Verbose;
31
32### Make sure we get the _EUMM_NOXS_ version
33my $ModName = TEST_CONF_MODULE;
34
35### This is the module name that gets /installed/
36my $InstName = TEST_CONF_INST_MODULE;
37
38### don't start sending test reports now... ###
39$cb->_callbacks->send_test_report( sub { 0 } );
40$conf->set_conf( cpantest => 0 );
41
42### Redirect errors to file ###
43local $CPANPLUS::Error::ERROR_FH = output_handle() unless $Verbose;
44local $CPANPLUS::Error::MSG_FH = output_handle() unless $Verbose;
45*STDERR = output_handle() unless $Verbose;
46
47### dont uncomment this, it screws up where STDOUT goes and makes
48### test::harness create test counter mismatches
49#*STDOUT = output_handle() unless @ARGV;
50### for the same test-output counter mismatch, we disable verbose
51### mode
52$conf->set_conf( verbose => $Verbose );
53$conf->set_conf( allow_build_interactivity => 0 );
54
55### start with fresh sources ###
56ok( $cb->reload_indices( update_source => 0 ),
57 "Rebuilding trees" );
58
59### we might need this Some Day when we're going to install into
60### our own sandbox dir.. but for now, no dice due to EU::I bug
61# $conf->set_program( sudo => '' );
62# $conf->set_conf( makemakerflags => TEST_INSTALL_EU_MM_FLAGS );
63
64### set alternate install dir ###
65### XXX rather pointless, since we can't uninstall them, due to a bug
66### in EU::Installed (6871). And therefor we can't test uninstall() or any of
67### the EU::Installed functions. So, let's just install into sitelib... =/
68#my $prefix = File::Spec->rel2abs( File::Spec->catdir(cwd(),'dummy-perl') );
69#my $rv = $cb->configure_object->set_conf( makemakerflags => "PREFIX=$prefix" );
70#ok( $rv, "Alternate install path set" );
71
72my $Mod = $cb->module_tree( $ModName );
73my $InstMod = $cb->module_tree( $InstName );
74ok( $Mod, "Loaded object for: " . $Mod->name );
75ok( $Mod, "Loaded object for: " . $InstMod->name );
76
77### format_available tests ###
78{ ok( CPANPLUS::Dist::MM->format_available,
79 "Format is available" );
80
81 ### whitebox test!
82 { local $^W;
83 local *CPANPLUS::Dist::MM::can_load = sub { 0 };
84 ok(!CPANPLUS::Dist::MM->format_available,
85 " Making format unavailable" );
86 }
87
88 ### test if the error got logged ok ###
89 like( CPANPLUS::Error->stack_as_string,
90 qr/You do not have .+?'CPANPLUS::Dist::MM' not available/s,
91 " Format failure logged" );
92
93 ### flush the stack ###
94 CPANPLUS::Error->flush;
95}
96
97ok( $Mod->fetch, "Fetching module to ".$Mod->status->fetch );
98ok( $Mod->extract, "Extracting module to ".$Mod->status->extract );
99
100ok( $Mod->test, "Testing module" );
101
102ok( $Mod->status->dist_cpan->status->test,
103 " Test success registered as status" );
104ok( $Mod->status->dist_cpan->status->prepared,
105 " Prepared status registered" );
106ok( $Mod->status->dist_cpan->status->created,
107 " Created status registered" );
108is( $Mod->status->dist_cpan->status->distdir, $Mod->status->extract,
109 " Distdir status registered properly" );
110
111### test the convenience methods
112ok( $Mod->prepare, "Preparing module" );
113ok( $Mod->create, "Creating module" );
114
115ok( $Mod->dist, "Building distribution" );
116ok( $Mod->status->dist_cpan, " Dist registered as status" );
117isa_ok( $Mod->status->dist_cpan, "CPANPLUS::Dist::MM" );
118
119### flush the lib cache
120### otherwise, cpanplus thinks the module's already installed
121### since the blib is already in @INC
122$cb->_flush( list => [qw|lib|] );
123
124SKIP: {
125
126 skip(q[No install tests under core perl], 10) if $ENV{PERL_CORE};
127
128 skip(q[Probably no permissions to install, skipping], 10)
129 if $noperms;
130
131 ### XXX new EU::I should be forthcoming pending this patch from Steffen
132 ### Mueller on p5p: http://www.xray.mpe.mpg.de/mailing-lists/ \
133 ### perl5-porters/2007-01/msg00895.html
134 ### This should become EU::I 1.42.. if so, we should upgrade this bit of
135 ### code and remove the diag, since we can then install in our dummy dir..
136 diag("\nSorry, installing into your real perl dir, rather than our test");
137 diag("area since ExtUtils::Installed does not probe for .packlists in " );
138 diag('other dirs than those in %Config. See bug #6871 on rt.cpan.org ' );
139 diag('for details');
140
141 diag(q[Note: 'sudo' might ask for your password to do the install test])
142 if $conf->get_program('sudo');
143
144 ok( $Mod->install( force =>1 ),
145 "Installing module" );
146 ok( $Mod->status->installed," Module installed according to status" );
147
148
149 SKIP: { ### EU::Installed tests ###
150
151 skip("makemakerflags set -- probably EU::Installed tests will fail", 8)
152 if $conf->get_conf('makemakerflags');
153
154 skip( "Old perl on cygwin detected " .
155 "-- tests will fail due to known bugs", 8
156 ) if ON_OLD_CYGWIN;
157
158 ### might need it Later when EU::I is fixed..
159 #local @INC = ( TEST_INSTALL_DIR_LIB, @INC );
160
161 { ### validate
162 my @missing = $InstMod->validate;
163
164 is_deeply( \@missing, [],
165 "No missing files" );
166 }
167
168 { ### files
169 my @files = $InstMod->files;
170
171 ### number of files may vary from OS to OS
172 ok( scalar(@files), "All files accounted for" );
173 ok( grep( /$File/, @files),
174 " Found the module" );
175
176 ### XXX does this work on all OSs?
177 #ok( grep( /man/, @files ),
178 # " Found the manpage" );
179 }
180
181 { ### packlist
182 my ($obj) = $InstMod->packlist;
183 isa_ok( $obj, "ExtUtils::Packlist" );
184 }
185
186 { ### directory_tree
187 my @dirs = $InstMod->directory_tree;
188 ok( scalar(@dirs), "Directory tree obtained" );
189
190 my $found;
191 for my $dir (@dirs) {
192 ok( -d $dir, " Directory exists" );
193
194 my $file = File::Spec->catfile( $dir, $File );
195 $found = $file if -e $file;
196 }
197
198 ok( -e $found, " Module found" );
199 }
200
201 SKIP: {
202 skip("Probably no permissions to uninstall", 1)
203 if $noperms;
204
205 ok( $InstMod->uninstall,"Uninstalling module" );
206 }
207 }
208}
209
210### test exceptions in Dist::MM->create ###
211{ ok( $Mod->status->mk_flush, "Old status info flushed" );
212 my $dist = CPANPLUS::Dist->new( module => $Mod,
213 format => INSTALLER_MM );
214
215 ok( $dist, "New dist object made" );
216 ok(!$dist->prepare, " Dist->prepare failed" );
217 like( CPANPLUS::Error->stack_as_string, qr/No dir found to operate on/,
218 " Failure logged" );
219
220 ### manually set the extract dir,
221 $Mod->status->extract($0);
222
223 ok(!$dist->create, " Dist->create failed" );
224 like( CPANPLUS::Error->stack_as_string, qr/not successfully prepared/s,
225 " Failure logged" );
226
227 ### pretend we've been prepared ###
228 $dist->status->prepared(1);
229
230 ok(!$dist->create, " Dist->create failed" );
231 like( CPANPLUS::Error->stack_as_string, qr/Could not chdir/s,
232 " Failure logged" );
233}
234
235### writemakefile.pl tests ###
236{ ### remove old status info
237 ok( $Mod->status->mk_flush, "Old status info flushed" );
238 ok( $Mod->fetch, "Module fetched again" );
239 ok( $Mod->extract, "Module extracted again" );
240
241 ### cheat and add fake prereqs ###
242 my $prereq = TEST_CONF_PREREQ;
243
244 $Mod->status->prereqs( { $prereq => 0 } );
245
246 my $makefile_pl = MAKEFILE_PL->( $Mod->status->extract );
247 my $makefile = MAKEFILE->( $Mod->status->extract );
248
249 my $dist = $Mod->dist;
250 ok( $dist, "Dist object built" );
251
252 ### check for a makefile.pl and 'write' one
253 ok( -s $makefile_pl, " Makefile.PL present" );
254 ok( $dist->write_makefile_pl( force => 0 ),
255 " Makefile.PL written" );
256 like( CPANPLUS::Error->stack_as_string, qr/Already created/,
257 " Prior existance noted" );
258
259 ### ok, unlink the makefile.pl, now really write one
260 unlink $makefile;
261
262 ok( unlink($makefile_pl), "Deleting Makefile.PL");
263 ok( !-s $makefile_pl, " Makefile.PL deleted" );
264 ok( !-s $makefile, " Makefile deleted" );
265 ok($dist->write_makefile_pl," Makefile.PL written" );
266
267 ### see if we wrote anything sensible
268 my $fh = OPEN_FILE->( $makefile_pl );
269 ok( $fh, "Makefile.PL open for read" );
270
271 my $str = do { local $/; <$fh> };
272 like( $str, qr/### Auto-generated .+ by CPANPLUS ###/,
273 " Autogeneration noted" );
274 like( $str, '/'. $Mod->module .'/',
275 " Contains module name" );
276 like( $str, '/'. quotemeta($Mod->version) . '/',
277 " Contains version" );
278 like( $str, '/'. $Mod->author->author .'/',
279 " Contains author" );
280 like( $str, '/PREREQ_PM/', " Contains prereqs" );
281 like( $str, qr/$prereq.+0/, " Contains prereqs" );
282
283 close $fh;
284
285 ### seems ok, now delete it again and go via install()
286 ### to see if it picks up on the missing makefile.pl and
287 ### does the right thing
288 ok( unlink($makefile_pl), "Deleting Makefile.PL");
289 ok( !-s $makefile_pl, " Makefile.PL deleted" );
290 ok( $dist->status->mk_flush,"Dist status flushed" );
291 ok( $dist->prepare, " Dist->prepare run again" );
292 ok( $dist->create, " Dist->create run again" );
293 ok( -s $makefile_pl, " Makefile.PL present" );
294 like( CPANPLUS::Error->stack_as_string,
295 qr/attempting to generate one/,
296 " Makefile.PL generation attempt logged" );
297
298 ### now let's throw away the makefile.pl, flush the status and not
299 ### write a makefile.pl
300 { local $^W;
301 local *CPANPLUS::Dist::MM::write_makefile_pl = sub { 1 };
302
303 unlink $makefile_pl;
304 unlink $makefile;
305
306 ok(!-s $makefile_pl, "Makefile.PL deleted" );
307 ok(!-s $makefile, "Makefile deleted" );
308 ok( $dist->status->mk_flush,"Dist status flushed" );
309 ok(!$dist->prepare, " Dist->prepare failed" );
310 like( CPANPLUS::Error->stack_as_string,
311 qr/Could not find 'Makefile.PL'/i,
312 " Missing Makefile.PL noted" );
313 is( $dist->status->makefile, 0,
314 " Did not manage to create Makefile" );
315 }
316
317 ### now let's write a makefile.pl that just does 'die'
318 { local $^W;
319 local *CPANPLUS::Dist::MM::write_makefile_pl =
320 __PACKAGE__->_custom_makefile_pl_sub( "exit 1;" );
321
322 ### there's no makefile.pl now, since the previous test failed
323 ### to create one
324 #ok( -e $makefile_pl, "Makefile.PL exists" );
325 #ok( unlink($makefile_pl), " Deleting Makefile.PL");
326 ok(!-s $makefile_pl, "Makefile.PL deleted" );
327 ok( $dist->status->mk_flush,"Dist status flushed" );
328 ok(!$dist->prepare, " Dist->prepare failed" );
329 like( CPANPLUS::Error->stack_as_string, qr/Could not run/s,
330 " Logged failed 'perl Makefile.PL'" );
331 is( $dist->status->makefile, 0,
332 " Did not manage to create Makefile" );
333 }
334
335 ### clean up afterwards ###
336 ok( unlink($makefile_pl), "Deleting Makefile.PL");
337 $dist->status->mk_flush;
338
339}
340
341### test ENV setting in Makefile.PL
342{ ### use print() not die() -- we're redirecting STDERR in tests!
343 my $env = ENV_CPANPLUS_IS_EXECUTING;
344 my $sub = __PACKAGE__->_custom_makefile_pl_sub(
345 "print qq[ENV=\$ENV{$env}\n]; exit 1;" );
346
347 my $clone = $Mod->clone;
348 $clone->status->fetch( $Mod->status->fetch );
349
350 ok( $clone, 'Testing ENV settings $dist->prepare' );
351 ok( $clone->extract, ' Files extracted' );
352 ok( $clone->prepare, ' $mod->prepare worked first time' );
353
354 my $dist = $clone->status->dist;
355 my $makefile_pl = MAKEFILE_PL->( $clone->status->extract );
356
357 ok( $sub->($dist), " Custom Makefile.PL written" );
358 ok( -e $makefile_pl, " File exists" );
359
360 ### clear errors
361 CPANPLUS::Error->flush;
362
363 my $rv = $dist->prepare( force => 1, verbose => 0 );
364 ok( !$rv, ' $dist->prepare failed' );
365
366 SKIP: {
367 skip( "Can't test ENV{$env} -- no buffers available", 1 )
368 unless IPC::Cmd->can_capture_buffer;
369
370 my $re = quotemeta( $makefile_pl );
371 like( CPANPLUS::Error->stack_as_string, qr/ENV=$re/,
372 " \$ENV $env set correctly during execution");
373 }
374
375 ### and the ENV var should no longer be set now
376 ok( !$ENV{$env}, " ENV var now unset" );
377}
378
379sub _custom_makefile_pl_sub {
380 my $pkg = shift;
381 my $txt = shift or return;
382
383 return sub {
384 my $dist = shift;
385 my $self = $dist->parent;
386 my $fh = OPEN_FILE->(
387 MAKEFILE_PL->($self->status->extract), '>' );
388 print $fh $txt;
389 close $fh;
390
391 return 1;
392 }
393}
394
395
396# Local variables:
397# c-indentation-style: bsd
398# c-basic-offset: 4
399# indent-tabs-mode: nil
400# End:
401# vim: expandtab shiftwidth=4:
402
403