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 ### |
43 | local $CPANPLUS::Error::ERROR_FH = output_handle() unless $Verbose; |
44 | local $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 ### |
56 | ok( $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 | |
72 | my $Mod = $cb->module_tree( $ModName ); |
73 | my $InstMod = $cb->module_tree( $InstName ); |
74 | ok( $Mod, "Loaded object for: " . $Mod->name ); |
75 | ok( $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 | |
97 | ok( $Mod->fetch, "Fetching module to ".$Mod->status->fetch ); |
98 | ok( $Mod->extract, "Extracting module to ".$Mod->status->extract ); |
99 | |
100 | ok( $Mod->test, "Testing module" ); |
101 | |
102 | ok( $Mod->status->dist_cpan->status->test, |
103 | " Test success registered as status" ); |
104 | ok( $Mod->status->dist_cpan->status->prepared, |
105 | " Prepared status registered" ); |
106 | ok( $Mod->status->dist_cpan->status->created, |
107 | " Created status registered" ); |
108 | is( $Mod->status->dist_cpan->status->distdir, $Mod->status->extract, |
109 | " Distdir status registered properly" ); |
110 | |
111 | ### test the convenience methods |
112 | ok( $Mod->prepare, "Preparing module" ); |
113 | ok( $Mod->create, "Creating module" ); |
114 | |
115 | ok( $Mod->dist, "Building distribution" ); |
116 | ok( $Mod->status->dist_cpan, " Dist registered as status" ); |
117 | isa_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 | |
124 | SKIP: { |
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 | |
379 | sub _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 | |