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