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 | |
5879cbe1 |
132 | ### we now say 'no perms' if sudo is configured, as per #29904 |
133 | #diag(q[Note: 'sudo' might ask for your password to do the install test]) |
134 | # if $conf->get_program('sudo'); |
6aaee015 |
135 | |
5bc5f6dc |
136 | ### make sure no options are set in PERL5_MM_OPT, as they might |
137 | ### change the installation target and therefor will 1. mess up |
138 | ### the tests and 2. leave an installed copy of our test module |
139 | ### lying around. This addresses bug #29716: 20_CPANPLUS-Dist-MM.t |
140 | ### fails (and leaves test files installed) when EUMM options |
141 | ### include INSTALL_BASE |
142 | { local $ENV{'PERL5_MM_OPT'}; |
143 | |
4443dd53 |
144 | ### add the new dir to the configuration too, so eu::installed tests |
145 | ### work as they should |
146 | $conf->set_conf( lib => [ TEST_CONF_INSTALL_DIR ] ); |
147 | |
148 | ok( $Mod->install( force => 1, |
149 | makemakerflags => 'PREFIX='.TEST_CONF_INSTALL_DIR, |
150 | ), "Installing module" ); |
5bc5f6dc |
151 | } |
152 | |
6aaee015 |
153 | ok( $Mod->status->installed," Module installed according to status" ); |
154 | |
155 | |
156 | SKIP: { ### EU::Installed tests ### |
6aaee015 |
157 | |
158 | skip( "Old perl on cygwin detected " . |
159 | "-- tests will fail due to known bugs", 8 |
160 | ) if ON_OLD_CYGWIN; |
161 | |
162 | ### might need it Later when EU::I is fixed.. |
163 | #local @INC = ( TEST_INSTALL_DIR_LIB, @INC ); |
164 | |
165 | { ### validate |
166 | my @missing = $InstMod->validate; |
167 | |
168 | is_deeply( \@missing, [], |
169 | "No missing files" ); |
170 | } |
171 | |
172 | { ### files |
173 | my @files = $InstMod->files; |
174 | |
175 | ### number of files may vary from OS to OS |
176 | ok( scalar(@files), "All files accounted for" ); |
177 | ok( grep( /$File/, @files), |
178 | " Found the module" ); |
179 | |
180 | ### XXX does this work on all OSs? |
181 | #ok( grep( /man/, @files ), |
182 | # " Found the manpage" ); |
183 | } |
184 | |
185 | { ### packlist |
186 | my ($obj) = $InstMod->packlist; |
187 | isa_ok( $obj, "ExtUtils::Packlist" ); |
188 | } |
189 | |
190 | { ### directory_tree |
191 | my @dirs = $InstMod->directory_tree; |
192 | ok( scalar(@dirs), "Directory tree obtained" ); |
193 | |
194 | my $found; |
195 | for my $dir (@dirs) { |
196 | ok( -d $dir, " Directory exists" ); |
197 | |
198 | my $file = File::Spec->catfile( $dir, $File ); |
199 | $found = $file if -e $file; |
200 | } |
201 | |
202 | ok( -e $found, " Module found" ); |
203 | } |
204 | |
205 | SKIP: { |
206 | skip("Probably no permissions to uninstall", 1) |
207 | if $noperms; |
208 | |
209 | ok( $InstMod->uninstall,"Uninstalling module" ); |
210 | } |
211 | } |
212 | } |
213 | |
214 | ### test exceptions in Dist::MM->create ### |
215 | { ok( $Mod->status->mk_flush, "Old status info flushed" ); |
4443dd53 |
216 | my $dist = INSTALLER_MM->new( module => $Mod ); |
217 | |
6aaee015 |
218 | ok( $dist, "New dist object made" ); |
219 | ok(!$dist->prepare, " Dist->prepare failed" ); |
220 | like( CPANPLUS::Error->stack_as_string, qr/No dir found to operate on/, |
221 | " Failure logged" ); |
222 | |
223 | ### manually set the extract dir, |
224 | $Mod->status->extract($0); |
225 | |
226 | ok(!$dist->create, " Dist->create failed" ); |
227 | like( CPANPLUS::Error->stack_as_string, qr/not successfully prepared/s, |
228 | " Failure logged" ); |
229 | |
230 | ### pretend we've been prepared ### |
231 | $dist->status->prepared(1); |
232 | |
233 | ok(!$dist->create, " Dist->create failed" ); |
234 | like( CPANPLUS::Error->stack_as_string, qr/Could not chdir/s, |
235 | " Failure logged" ); |
236 | } |
237 | |
238 | ### writemakefile.pl tests ### |
239 | { ### remove old status info |
240 | ok( $Mod->status->mk_flush, "Old status info flushed" ); |
241 | ok( $Mod->fetch, "Module fetched again" ); |
242 | ok( $Mod->extract, "Module extracted again" ); |
243 | |
244 | ### cheat and add fake prereqs ### |
245 | my $prereq = TEST_CONF_PREREQ; |
246 | |
247 | $Mod->status->prereqs( { $prereq => 0 } ); |
248 | |
249 | my $makefile_pl = MAKEFILE_PL->( $Mod->status->extract ); |
250 | my $makefile = MAKEFILE->( $Mod->status->extract ); |
251 | |
252 | my $dist = $Mod->dist; |
253 | ok( $dist, "Dist object built" ); |
254 | |
255 | ### check for a makefile.pl and 'write' one |
256 | ok( -s $makefile_pl, " Makefile.PL present" ); |
257 | ok( $dist->write_makefile_pl( force => 0 ), |
258 | " Makefile.PL written" ); |
259 | like( CPANPLUS::Error->stack_as_string, qr/Already created/, |
260 | " Prior existance noted" ); |
261 | |
262 | ### ok, unlink the makefile.pl, now really write one |
5bc5f6dc |
263 | 1 while unlink $makefile; |
264 | |
265 | ### must do '1 while' for VMS |
266 | { my $unlink_sts = unlink($makefile_pl); |
267 | 1 while unlink $makefile_pl; |
268 | ok( $unlink_sts, "Deleting Makefile.PL"); |
269 | } |
6aaee015 |
270 | |
6aaee015 |
271 | ok( !-s $makefile_pl, " Makefile.PL deleted" ); |
272 | ok( !-s $makefile, " Makefile deleted" ); |
273 | ok($dist->write_makefile_pl," Makefile.PL written" ); |
274 | |
275 | ### see if we wrote anything sensible |
276 | my $fh = OPEN_FILE->( $makefile_pl ); |
277 | ok( $fh, "Makefile.PL open for read" ); |
278 | |
279 | my $str = do { local $/; <$fh> }; |
280 | like( $str, qr/### Auto-generated .+ by CPANPLUS ###/, |
281 | " Autogeneration noted" ); |
282 | like( $str, '/'. $Mod->module .'/', |
283 | " Contains module name" ); |
284 | like( $str, '/'. quotemeta($Mod->version) . '/', |
285 | " Contains version" ); |
286 | like( $str, '/'. $Mod->author->author .'/', |
287 | " Contains author" ); |
288 | like( $str, '/PREREQ_PM/', " Contains prereqs" ); |
289 | like( $str, qr/$prereq.+0/, " Contains prereqs" ); |
290 | |
291 | close $fh; |
292 | |
293 | ### seems ok, now delete it again and go via install() |
294 | ### to see if it picks up on the missing makefile.pl and |
295 | ### does the right thing |
5bc5f6dc |
296 | ### must do '1 while' for VMS |
297 | { my $unlink_sts = unlink($makefile_pl); |
298 | 1 while unlink $makefile_pl; |
299 | ok( $unlink_sts, "Deleting Makefile.PL"); |
300 | } |
6aaee015 |
301 | ok( !-s $makefile_pl, " Makefile.PL deleted" ); |
302 | ok( $dist->status->mk_flush,"Dist status flushed" ); |
303 | ok( $dist->prepare, " Dist->prepare run again" ); |
304 | ok( $dist->create, " Dist->create run again" ); |
305 | ok( -s $makefile_pl, " Makefile.PL present" ); |
306 | like( CPANPLUS::Error->stack_as_string, |
307 | qr/attempting to generate one/, |
308 | " Makefile.PL generation attempt logged" ); |
309 | |
310 | ### now let's throw away the makefile.pl, flush the status and not |
311 | ### write a makefile.pl |
312 | { local $^W; |
313 | local *CPANPLUS::Dist::MM::write_makefile_pl = sub { 1 }; |
314 | |
5bc5f6dc |
315 | 1 while unlink $makefile_pl; |
316 | 1 while unlink $makefile; |
6aaee015 |
317 | |
318 | ok(!-s $makefile_pl, "Makefile.PL deleted" ); |
319 | ok(!-s $makefile, "Makefile deleted" ); |
320 | ok( $dist->status->mk_flush,"Dist status flushed" ); |
321 | ok(!$dist->prepare, " Dist->prepare failed" ); |
322 | like( CPANPLUS::Error->stack_as_string, |
323 | qr/Could not find 'Makefile.PL'/i, |
324 | " Missing Makefile.PL noted" ); |
325 | is( $dist->status->makefile, 0, |
326 | " Did not manage to create Makefile" ); |
327 | } |
328 | |
329 | ### now let's write a makefile.pl that just does 'die' |
330 | { local $^W; |
331 | local *CPANPLUS::Dist::MM::write_makefile_pl = |
332 | __PACKAGE__->_custom_makefile_pl_sub( "exit 1;" ); |
333 | |
334 | ### there's no makefile.pl now, since the previous test failed |
335 | ### to create one |
336 | #ok( -e $makefile_pl, "Makefile.PL exists" ); |
337 | #ok( unlink($makefile_pl), " Deleting Makefile.PL"); |
338 | ok(!-s $makefile_pl, "Makefile.PL deleted" ); |
339 | ok( $dist->status->mk_flush,"Dist status flushed" ); |
340 | ok(!$dist->prepare, " Dist->prepare failed" ); |
341 | like( CPANPLUS::Error->stack_as_string, qr/Could not run/s, |
342 | " Logged failed 'perl Makefile.PL'" ); |
343 | is( $dist->status->makefile, 0, |
344 | " Did not manage to create Makefile" ); |
345 | } |
346 | |
347 | ### clean up afterwards ### |
5bc5f6dc |
348 | ### must do '1 while' for VMS |
349 | { my $unlink_sts = unlink($makefile_pl); |
350 | 1 while unlink $makefile_pl; |
351 | ok( $unlink_sts, "Deleting Makefile.PL"); |
352 | } |
353 | |
6aaee015 |
354 | $dist->status->mk_flush; |
6aaee015 |
355 | } |
356 | |
357 | ### test ENV setting in Makefile.PL |
358 | { ### use print() not die() -- we're redirecting STDERR in tests! |
359 | my $env = ENV_CPANPLUS_IS_EXECUTING; |
360 | my $sub = __PACKAGE__->_custom_makefile_pl_sub( |
361 | "print qq[ENV=\$ENV{$env}\n]; exit 1;" ); |
362 | |
363 | my $clone = $Mod->clone; |
364 | $clone->status->fetch( $Mod->status->fetch ); |
365 | |
366 | ok( $clone, 'Testing ENV settings $dist->prepare' ); |
367 | ok( $clone->extract, ' Files extracted' ); |
368 | ok( $clone->prepare, ' $mod->prepare worked first time' ); |
369 | |
370 | my $dist = $clone->status->dist; |
371 | my $makefile_pl = MAKEFILE_PL->( $clone->status->extract ); |
372 | |
373 | ok( $sub->($dist), " Custom Makefile.PL written" ); |
374 | ok( -e $makefile_pl, " File exists" ); |
375 | |
376 | ### clear errors |
377 | CPANPLUS::Error->flush; |
378 | |
379 | my $rv = $dist->prepare( force => 1, verbose => 0 ); |
380 | ok( !$rv, ' $dist->prepare failed' ); |
381 | |
382 | SKIP: { |
383 | skip( "Can't test ENV{$env} -- no buffers available", 1 ) |
384 | unless IPC::Cmd->can_capture_buffer; |
385 | |
386 | my $re = quotemeta( $makefile_pl ); |
387 | like( CPANPLUS::Error->stack_as_string, qr/ENV=$re/, |
388 | " \$ENV $env set correctly during execution"); |
389 | } |
390 | |
391 | ### and the ENV var should no longer be set now |
392 | ok( !$ENV{$env}, " ENV var now unset" ); |
393 | } |
394 | |
395 | sub _custom_makefile_pl_sub { |
396 | my $pkg = shift; |
397 | my $txt = shift or return; |
398 | |
399 | return sub { |
400 | my $dist = shift; |
401 | my $self = $dist->parent; |
402 | my $fh = OPEN_FILE->( |
403 | MAKEFILE_PL->($self->status->extract), '>' ); |
404 | print $fh $txt; |
405 | close $fh; |
406 | |
407 | return 1; |
408 | } |
409 | } |
410 | |
411 | |
412 | # Local variables: |
413 | # c-indentation-style: bsd |
414 | # c-basic-offset: 4 |
415 | # indent-tabs-mode: nil |
416 | # End: |
417 | # vim: expandtab shiftwidth=4: |
418 | |
419 | |