Commit | Line | Data |
6aaee015 |
1 | ### make sure we can find our conf.pl file |
2 | BEGIN { |
3 | use FindBin; |
4 | require "$FindBin::Bin/inc/conf.pl"; |
5 | } |
6 | |
7 | use strict; |
8 | |
9 | use CPANPLUS::Configure; |
10 | use CPANPLUS::Backend; |
11 | use CPANPLUS::Dist; |
12 | use CPANPLUS::Dist::MM; |
13 | use CPANPLUS::Internals::Constants; |
14 | |
15 | use Test::More 'no_plan'; |
16 | use Cwd; |
17 | use Config; |
18 | use Data::Dumper; |
19 | use File::Basename (); |
20 | use File::Spec (); |
21 | |
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} ); |
27 | my $File = 'Bar.pm'; |
28 | my $Verbose = @ARGV ? 1 : 0; |
29 | |
30 | #$IPC::Cmd::DEBUG = $Verbose; |
31 | |
32 | ### Make sure we get the _EUMM_NOXS_ version |
33 | my $ModName = TEST_CONF_MODULE; |
34 | |
35 | ### This is the module name that gets /installed/ |
36 | my $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 ### |
6aaee015 |
43 | *STDERR = output_handle() unless $Verbose; |
44 | |
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 |
49 | ### mode |
50 | $conf->set_conf( verbose => $Verbose ); |
51 | $conf->set_conf( allow_build_interactivity => 0 ); |
52 | |
53 | ### start with fresh sources ### |
54 | ok( $cb->reload_indices( update_source => 0 ), |
55 | "Rebuilding trees" ); |
56 | |
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 ); |
61 | |
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" ); |
69 | |
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 ); |
74 | |
75 | ### format_available tests ### |
76 | { ok( CPANPLUS::Dist::MM->format_available, |
77 | "Format is available" ); |
78 | |
79 | ### whitebox test! |
80 | { local $^W; |
81 | local *CPANPLUS::Dist::MM::can_load = sub { 0 }; |
82 | ok(!CPANPLUS::Dist::MM->format_available, |
83 | " Making format unavailable" ); |
84 | } |
85 | |
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" ); |
90 | |
91 | ### flush the stack ### |
92 | CPANPLUS::Error->flush; |
93 | } |
94 | |
95 | ok( $Mod->fetch, "Fetching module to ".$Mod->status->fetch ); |
96 | ok( $Mod->extract, "Extracting module to ".$Mod->status->extract ); |
97 | |
98 | ok( $Mod->test, "Testing module" ); |
99 | |
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" ); |
108 | |
109 | ### test the convenience methods |
110 | ok( $Mod->prepare, "Preparing module" ); |
111 | ok( $Mod->create, "Creating module" ); |
112 | |
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" ); |
116 | |
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|] ); |
121 | |
122 | SKIP: { |
123 | |
124 | skip(q[No install tests under core perl], 10) if $ENV{PERL_CORE}; |
125 | |
126 | skip(q[Probably no permissions to install, skipping], 10) |
127 | if $noperms; |
128 | |
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 ' ); |
137 | diag('for details'); |
138 | |
139 | diag(q[Note: 'sudo' might ask for your password to do the install test]) |
140 | if $conf->get_program('sudo'); |
141 | |
5bc5f6dc |
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'}; |
149 | |
150 | ok( $Mod->install( force =>1 ), |
6aaee015 |
151 | "Installing module" ); |
5bc5f6dc |
152 | } |
153 | |
6aaee015 |
154 | ok( $Mod->status->installed," Module installed according to status" ); |
155 | |
156 | |
157 | SKIP: { ### EU::Installed tests ### |
158 | |
159 | skip("makemakerflags set -- probably EU::Installed tests will fail", 8) |
160 | if $conf->get_conf('makemakerflags'); |
161 | |
162 | skip( "Old perl on cygwin detected " . |
163 | "-- tests will fail due to known bugs", 8 |
164 | ) if ON_OLD_CYGWIN; |
165 | |
166 | ### might need it Later when EU::I is fixed.. |
167 | #local @INC = ( TEST_INSTALL_DIR_LIB, @INC ); |
168 | |
169 | { ### validate |
170 | my @missing = $InstMod->validate; |
171 | |
172 | is_deeply( \@missing, [], |
173 | "No missing files" ); |
174 | } |
175 | |
176 | { ### files |
177 | my @files = $InstMod->files; |
178 | |
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" ); |
183 | |
184 | ### XXX does this work on all OSs? |
185 | #ok( grep( /man/, @files ), |
186 | # " Found the manpage" ); |
187 | } |
188 | |
189 | { ### packlist |
190 | my ($obj) = $InstMod->packlist; |
191 | isa_ok( $obj, "ExtUtils::Packlist" ); |
192 | } |
193 | |
194 | { ### directory_tree |
195 | my @dirs = $InstMod->directory_tree; |
196 | ok( scalar(@dirs), "Directory tree obtained" ); |
197 | |
198 | my $found; |
199 | for my $dir (@dirs) { |
200 | ok( -d $dir, " Directory exists" ); |
201 | |
202 | my $file = File::Spec->catfile( $dir, $File ); |
203 | $found = $file if -e $file; |
204 | } |
205 | |
206 | ok( -e $found, " Module found" ); |
207 | } |
208 | |
209 | SKIP: { |
210 | skip("Probably no permissions to uninstall", 1) |
211 | if $noperms; |
212 | |
213 | ok( $InstMod->uninstall,"Uninstalling module" ); |
214 | } |
215 | } |
216 | } |
217 | |
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 ); |
222 | |
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/, |
226 | " Failure logged" ); |
227 | |
228 | ### manually set the extract dir, |
229 | $Mod->status->extract($0); |
230 | |
231 | ok(!$dist->create, " Dist->create failed" ); |
232 | like( CPANPLUS::Error->stack_as_string, qr/not successfully prepared/s, |
233 | " Failure logged" ); |
234 | |
235 | ### pretend we've been prepared ### |
236 | $dist->status->prepared(1); |
237 | |
238 | ok(!$dist->create, " Dist->create failed" ); |
239 | like( CPANPLUS::Error->stack_as_string, qr/Could not chdir/s, |
240 | " Failure logged" ); |
241 | } |
242 | |
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" ); |
248 | |
249 | ### cheat and add fake prereqs ### |
250 | my $prereq = TEST_CONF_PREREQ; |
251 | |
252 | $Mod->status->prereqs( { $prereq => 0 } ); |
253 | |
254 | my $makefile_pl = MAKEFILE_PL->( $Mod->status->extract ); |
255 | my $makefile = MAKEFILE->( $Mod->status->extract ); |
256 | |
257 | my $dist = $Mod->dist; |
258 | ok( $dist, "Dist object built" ); |
259 | |
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" ); |
266 | |
267 | ### ok, unlink the makefile.pl, now really write one |
5bc5f6dc |
268 | 1 while unlink $makefile; |
269 | |
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"); |
274 | } |
6aaee015 |
275 | |
6aaee015 |
276 | ok( !-s $makefile_pl, " Makefile.PL deleted" ); |
277 | ok( !-s $makefile, " Makefile deleted" ); |
278 | ok($dist->write_makefile_pl," Makefile.PL written" ); |
279 | |
280 | ### see if we wrote anything sensible |
281 | my $fh = OPEN_FILE->( $makefile_pl ); |
282 | ok( $fh, "Makefile.PL open for read" ); |
283 | |
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" ); |
295 | |
296 | close $fh; |
297 | |
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 |
5bc5f6dc |
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"); |
305 | } |
6aaee015 |
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" ); |
314 | |
315 | ### now let's throw away the makefile.pl, flush the status and not |
316 | ### write a makefile.pl |
317 | { local $^W; |
318 | local *CPANPLUS::Dist::MM::write_makefile_pl = sub { 1 }; |
319 | |
5bc5f6dc |
320 | 1 while unlink $makefile_pl; |
321 | 1 while unlink $makefile; |
6aaee015 |
322 | |
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" ); |
332 | } |
333 | |
334 | ### now let's write a makefile.pl that just does 'die' |
335 | { local $^W; |
336 | local *CPANPLUS::Dist::MM::write_makefile_pl = |
337 | __PACKAGE__->_custom_makefile_pl_sub( "exit 1;" ); |
338 | |
339 | ### there's no makefile.pl now, since the previous test failed |
340 | ### to create one |
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" ); |
350 | } |
351 | |
352 | ### clean up afterwards ### |
5bc5f6dc |
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"); |
357 | } |
358 | |
6aaee015 |
359 | $dist->status->mk_flush; |
6aaee015 |
360 | } |
361 | |
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;" ); |
367 | |
368 | my $clone = $Mod->clone; |
369 | $clone->status->fetch( $Mod->status->fetch ); |
370 | |
371 | ok( $clone, 'Testing ENV settings $dist->prepare' ); |
372 | ok( $clone->extract, ' Files extracted' ); |
373 | ok( $clone->prepare, ' $mod->prepare worked first time' ); |
374 | |
375 | my $dist = $clone->status->dist; |
376 | my $makefile_pl = MAKEFILE_PL->( $clone->status->extract ); |
377 | |
378 | ok( $sub->($dist), " Custom Makefile.PL written" ); |
379 | ok( -e $makefile_pl, " File exists" ); |
380 | |
381 | ### clear errors |
382 | CPANPLUS::Error->flush; |
383 | |
384 | my $rv = $dist->prepare( force => 1, verbose => 0 ); |
385 | ok( !$rv, ' $dist->prepare failed' ); |
386 | |
387 | SKIP: { |
388 | skip( "Can't test ENV{$env} -- no buffers available", 1 ) |
389 | unless IPC::Cmd->can_capture_buffer; |
390 | |
391 | my $re = quotemeta( $makefile_pl ); |
392 | like( CPANPLUS::Error->stack_as_string, qr/ENV=$re/, |
393 | " \$ENV $env set correctly during execution"); |
394 | } |
395 | |
396 | ### and the ENV var should no longer be set now |
397 | ok( !$ENV{$env}, " ENV var now unset" ); |
398 | } |
399 | |
400 | sub _custom_makefile_pl_sub { |
401 | my $pkg = shift; |
402 | my $txt = shift or return; |
403 | |
404 | return sub { |
405 | my $dist = shift; |
406 | my $self = $dist->parent; |
407 | my $fh = OPEN_FILE->( |
408 | MAKEFILE_PL->($self->status->extract), '>' ); |
409 | print $fh $txt; |
410 | close $fh; |
411 | |
412 | return 1; |
413 | } |
414 | } |
415 | |
416 | |
417 | # Local variables: |
418 | # c-indentation-style: bsd |
419 | # c-basic-offset: 4 |
420 | # indent-tabs-mode: nil |
421 | # End: |
422 | # vim: expandtab shiftwidth=4: |
423 | |
424 | |