Commit | Line | Data |
bb4e9162 |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
4 | use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib'; |
5 | use MBTest; |
6 | use File::Spec; |
7a827510 |
7 | use IO::File; |
bb4e9162 |
8 | use Config; |
9 | |
10 | # Don't let our own verbosity/test_file get mixed up with our subprocess's |
11 | my @makefile_keys = qw(TEST_VERBOSE HARNESS_VERBOSE TEST_FILES MAKEFLAGS); |
12 | local @ENV{@makefile_keys}; |
13 | delete @ENV{@makefile_keys}; |
14 | |
15 | my @makefile_types = qw(small passthrough traditional); |
7a827510 |
16 | my $tests_per_type = 14; |
bb4e9162 |
17 | if ( $Config{make} && find_in_path($Config{make}) ) { |
7a827510 |
18 | plan tests => 38 + @makefile_types*$tests_per_type*2; |
bb4e9162 |
19 | } else { |
20 | plan skip_all => "Don't know how to invoke 'make'"; |
21 | } |
7a827510 |
22 | ok 1, "Loaded"; |
bb4e9162 |
23 | |
24 | |
25 | ######################### |
26 | |
27 | use Cwd (); |
28 | my $cwd = Cwd::cwd; |
7a827510 |
29 | my $tmp = MBTest->tmpdir; |
bb4e9162 |
30 | |
7a827510 |
31 | # Create test distribution; set requires and build_requires |
bb4e9162 |
32 | use DistGen; |
33 | my $dist = DistGen->new( dir => $tmp ); |
34 | $dist->regen; |
35 | |
36 | chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!"; |
37 | |
38 | |
39 | ######################### |
40 | |
41 | use Module::Build; |
42 | use Module::Build::Compat; |
43 | |
44 | use Carp; $SIG{__WARN__} = \&Carp::cluck; |
45 | |
46 | my @make = $Config{make} eq 'nmake' ? ('nmake', '-nologo') : ($Config{make}); |
47 | |
48 | ######################### |
49 | |
7a827510 |
50 | # Test without requires |
bb4e9162 |
51 | |
7a827510 |
52 | test_makefile_types(); |
53 | |
54 | # Test with requires |
55 | |
56 | my $distname = $dist->name; |
57 | $dist->change_build_pl({ |
58 | module_name => $distname, |
59 | license => 'perl', |
60 | requires => { |
61 | 'perl' => $], |
62 | 'File::Spec' => 0, |
63 | }, |
64 | build_requires => { |
65 | 'Test::More' => 0, |
66 | }, |
67 | }); |
68 | |
69 | $dist->regen; |
70 | |
71 | test_makefile_types( requires => { |
72 | 'perl' => $], |
73 | 'File::Spec' => 0, |
74 | 'Test::More' => 0, |
75 | }); |
76 | |
77 | ###################### |
78 | |
79 | $dist->change_build_pl({ |
80 | module_name => $distname, |
81 | license => 'perl', |
82 | }); |
83 | $dist->regen; |
84 | |
85 | # Create M::B instance but don't pollute STDOUT |
86 | my $mb; |
87 | stdout_of( sub { |
88 | $mb = Module::Build->new_from_context; |
89 | }); |
90 | ok $mb, "Module::Build->new_from_context"; |
bb4e9162 |
91 | |
bb4e9162 |
92 | |
93 | { |
94 | # Make sure fake_makefile() can run without 'build_class', as it may be |
95 | # in older-generated Makefile.PLs |
96 | my $warning = ''; |
97 | local $SIG{__WARN__} = sub { $warning = shift; }; |
98 | my $maketext = eval { Module::Build::Compat->fake_makefile(makefile => 'Makefile') }; |
7a827510 |
99 | is $@, '', "fake_makefile lived"; |
100 | like $maketext, qr/^realclean/m, "found 'realclean' in fake_makefile output"; |
101 | like $warning, qr/build_class/, "saw warning about 'build_class'"; |
bb4e9162 |
102 | } |
103 | |
104 | { |
105 | # Make sure custom builder subclass is used in the created |
106 | # Makefile.PL - make sure it fails in the right way here. |
107 | local @Foo::Builder::ISA = qw(Module::Build); |
7a827510 |
108 | my $foo_builder; |
109 | stdout_of( sub { |
110 | $foo_builder = Foo::Builder->new_from_context; |
111 | }); |
bb4e9162 |
112 | foreach my $style ('passthrough', 'small') { |
113 | Module::Build::Compat->create_makefile_pl($style, $foo_builder); |
7a827510 |
114 | ok -e 'Makefile.PL', "$style Makefile.PL created"; |
bb4e9162 |
115 | |
116 | # Should fail with "can't find Foo/Builder.pm" |
7a827510 |
117 | my $result; |
118 | my ($stdout, $stderr ) = stdout_stderr_of (sub { |
119 | $result = $mb->run_perl_script('Makefile.PL'); |
120 | }); |
121 | ok ! $result, "Makefile.PL failed"; |
122 | like $stderr, qr{Foo/Builder.pm}, "custom builder wasn't found"; |
bb4e9162 |
123 | } |
124 | |
125 | # Now make sure it can actually work. |
7a827510 |
126 | my $bar_builder; |
127 | stdout_of( sub { |
128 | $bar_builder = Module::Build->subclass( class => 'Bar::Builder' )->new_from_context; |
129 | }); |
bb4e9162 |
130 | foreach my $style ('passthrough', 'small') { |
131 | Module::Build::Compat->create_makefile_pl($style, $bar_builder); |
7a827510 |
132 | ok -e 'Makefile.PL', "$style Makefile.PL created via subclass"; |
133 | my $result; |
134 | stdout_of( sub { |
135 | $result = $mb->run_perl_script('Makefile.PL'); |
136 | }); |
137 | ok $result, "Makefile.PL ran without error"; |
bb4e9162 |
138 | } |
139 | } |
140 | |
141 | { |
142 | # Make sure various Makefile.PL arguments are supported |
143 | Module::Build::Compat->create_makefile_pl('passthrough', $mb); |
144 | |
145 | my $libdir = File::Spec->catdir( $cwd, 't', 'libdir' ); |
7a827510 |
146 | my $result; |
147 | stdout_of( sub { |
148 | $result = $mb->run_perl_script('Makefile.PL', [], |
149 | [ |
150 | "LIB=$libdir", |
151 | 'TEST_VERBOSE=1', |
152 | 'INSTALLDIRS=perl', |
153 | 'POLLUTE=1', |
154 | ] |
155 | ); |
156 | }); |
157 | ok $result, "passthrough Makefile.PL ran with arguments"; |
158 | ok -e 'Build.PL', "Build.PL generated"; |
bb4e9162 |
159 | |
160 | my $new_build = Module::Build->resume(); |
7a827510 |
161 | is $new_build->installdirs, 'core', "installdirs is core"; |
162 | is $new_build->verbose, 1, "tests set for verbose"; |
163 | is $new_build->install_destination('lib'), $libdir, "custom libdir"; |
164 | is $new_build->extra_compiler_flags->[0], '-DPERL_POLLUTE', "PERL_POLLUTE set"; |
bb4e9162 |
165 | |
166 | # Make sure those switches actually had an effect |
167 | my ($ran_ok, $output); |
168 | $output = stdout_of( sub { $ran_ok = $new_build->do_system(@make, 'test') } ); |
7a827510 |
169 | ok $ran_ok, "make test ran without error"; |
bb4e9162 |
170 | $output =~ s/^/# /gm; # Don't confuse our own test output |
171 | like $output, qr/(?:# ok \d+\s+)+/, 'Should be verbose'; |
172 | |
173 | # Make sure various Makefile arguments are supported |
174 | $output = stdout_of( sub { $ran_ok = $mb->do_system(@make, 'test', 'TEST_VERBOSE=0') } ); |
7a827510 |
175 | ok $ran_ok, "make test without verbose ran ok"; |
bb4e9162 |
176 | $output =~ s/^/# /gm; # Don't confuse our own test output |
ba889e8f |
177 | like $output, |
178 | qr/(?:# .+basic\.+ok\s+(?:[\d.]+\s*m?s\s*)?(?:# \[[\d:]+\]\s*)?)# All tests/, |
bb4e9162 |
179 | 'Should be non-verbose'; |
180 | |
181 | $mb->delete_filetree($libdir); |
182 | ok ! -e $libdir, "Sample installation directory should be cleaned up"; |
183 | |
7a827510 |
184 | stdout_of( sub { $mb->do_system(@make, 'realclean'); } ); |
bb4e9162 |
185 | ok ! -e 'Makefile', "Makefile shouldn't exist"; |
186 | |
187 | 1 while unlink 'Makefile.PL'; |
7a827510 |
188 | ok ! -e 'Makefile.PL', "Makefile.PL cleaned up"; |
bb4e9162 |
189 | } |
190 | |
191 | { # Make sure tilde-expansion works |
192 | |
193 | # C<glob> on MSWin32 uses $ENV{HOME} if defined to do tilde-expansion |
194 | local $ENV{HOME} = 'C:/' if $^O =~ /MSWin/ && !exists( $ENV{HOME} ); |
195 | |
196 | Module::Build::Compat->create_makefile_pl('passthrough', $mb); |
197 | |
7a827510 |
198 | stdout_of( sub { |
199 | $mb->run_perl_script('Makefile.PL', [], ['INSTALL_BASE=~/foo']); |
200 | }); |
bb4e9162 |
201 | my $b2 = Module::Build->current; |
7a827510 |
202 | ok $b2->install_base, "install_base set"; |
bb4e9162 |
203 | unlike $b2->install_base, qr/^~/, "Tildes should be expanded"; |
204 | |
7a827510 |
205 | stdout_of( sub { $mb->do_system(@make, 'realclean'); } ); |
206 | ok ! -e 'Makefile', "Makefile shouldn't exist"; |
207 | |
bb4e9162 |
208 | 1 while unlink 'Makefile.PL'; |
7a827510 |
209 | ok ! -e 'Makefile.PL', "Makefile.PL cleaned up"; |
bb4e9162 |
210 | } |
7a827510 |
211 | |
bb4e9162 |
212 | ######################################################### |
213 | |
7a827510 |
214 | sub test_makefile_types { |
215 | my %opts = @_; |
216 | $opts{requires} ||= {}; |
217 | |
218 | foreach my $type (@makefile_types) { |
219 | # Create M::B instance |
220 | my $mb; |
221 | stdout_of( sub { |
222 | $mb = Module::Build->new_from_context; |
223 | }); |
224 | ok $mb, "Module::Build->new_from_context"; |
225 | |
226 | # Create and test Makefile.PL |
227 | Module::Build::Compat->create_makefile_pl($type, $mb); |
228 | ok -e 'Makefile.PL', "$type Makefile.PL created"; |
229 | test_makefile_pl_requires_perl( $opts{requires}{perl} ); |
230 | test_makefile_creation($mb); |
231 | test_makefile_prereq_pm( $opts{requires} ); |
232 | |
233 | my ($output,$success); |
234 | # Capture output to keep our STDOUT clean |
235 | $output = stdout_of( sub { |
236 | $success = $mb->do_system(@make); |
237 | }); |
238 | ok $success, "make ran without error"; |
239 | |
240 | # Can't let 'test' STDOUT go to our STDOUT, or it'll confuse Test::Harness. |
241 | $output = stdout_of( sub { |
242 | $success = $mb->do_system(@make, 'test'); |
243 | }); |
244 | ok $success, "make test ran without error"; |
245 | like uc $output, qr{DONE\.|SUCCESS}, "make test output indicated success"; |
246 | |
247 | $output = stdout_of( sub { |
248 | $success = $mb->do_system(@make, 'realclean'); |
249 | }); |
250 | ok $success, "make realclean ran without error"; |
251 | |
252 | # Try again with some Makefile.PL arguments |
253 | test_makefile_creation($mb, [], 'INSTALLDIRS=vendor', 1); |
254 | |
255 | 1 while unlink 'Makefile.PL'; |
256 | ok ! -e 'Makefile.PL', "cleaned up Makefile"; |
257 | } |
258 | } |
259 | |
bb4e9162 |
260 | sub test_makefile_creation { |
261 | my ($build, $preargs, $postargs, $cleanup) = @_; |
262 | |
7a827510 |
263 | my ($output, $result); |
264 | # capture output to avoid polluting our test output |
265 | $output = stdout_of( sub { |
266 | $result = $build->run_perl_script('Makefile.PL', $preargs, $postargs); |
267 | }); |
268 | my $label = "Makefile.PL ran without error"; |
269 | if ( defined $postargs && length $postargs ) { |
270 | $label .= " (postargs: $postargs)"; |
271 | } |
272 | ok $result, $label; |
273 | ok -e 'Makefile', "Makefile exists"; |
bb4e9162 |
274 | |
275 | if ($cleanup) { |
7a827510 |
276 | $output = stdout_of( sub { |
277 | $build->do_system(@make, 'realclean'); |
278 | }); |
279 | ok ! -e 'Makefile', "Makefile cleaned up"; |
280 | } |
281 | else { |
282 | pass '(skipping cleanup)'; # keep test count constant |
bb4e9162 |
283 | } |
284 | } |
285 | |
7a827510 |
286 | sub test_makefile_prereq_pm { |
287 | my %requires = %{ $_[0] }; |
288 | delete $requires{perl}; # until EU::MM supports this |
289 | SKIP: { |
290 | skip 'Makefile not found', 1 unless -e 'Makefile'; |
291 | my $prereq_pm = find_makefile_prereq_pm(); |
292 | is_deeply $prereq_pm, \%requires, |
293 | "Makefile has correct PREREQ_PM line"; |
294 | } |
295 | } |
296 | |
297 | sub test_makefile_pl_requires_perl { |
298 | my $perl_version = shift || q{}; |
299 | SKIP: { |
300 | skip 'Makefile.PL not found', 1 unless -e 'Makefile.PL'; |
301 | my $file_contents = slurp 'Makefile.PL'; |
302 | my $found_requires = $file_contents =~ m{^require $perl_version;}ms; |
303 | if (length $perl_version) { |
304 | ok $found_requires, "Makefile.PL has 'require $perl_version;'" |
305 | or diag "Makefile.PL:\n$file_contents"; |
306 | } |
307 | else { |
308 | ok ! $found_requires, "Makefile.PL does not require a perl version"; |
309 | } |
310 | } |
311 | } |
312 | |
313 | # Following subroutine adapted from code in CPAN.pm |
314 | # by Andreas Koenig and A. Speer. |
315 | sub find_makefile_prereq_pm { |
316 | my $fh = IO::File->new( 'Makefile', 'r' ) |
317 | or die "Can't read Makefile: $!"; |
318 | my $req = {}; |
319 | local($/) = "\n"; |
320 | while (<$fh>) { |
321 | # locate PREREQ_PM |
322 | last if /MakeMaker post_initialize section/; |
323 | my($p) = m{^[\#] |
324 | \s+PREREQ_PM\s+=>\s+(.+) |
325 | }x; |
326 | next unless $p; |
327 | |
328 | # extract modules |
329 | while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ){ |
330 | my($m,$n) = ($1,$2); |
331 | if ($n =~ /^q\[(.*?)\]$/) { |
332 | $n = $1; |
333 | } |
334 | $req->{$m} = $n; |
335 | } |
336 | last; |
337 | } |
338 | return $req; |
339 | } |
bb4e9162 |
340 | |
341 | # cleanup |
342 | chdir( $cwd ) or die "Can''t chdir to '$cwd': $!"; |
343 | $dist->remove; |
344 | |
345 | use File::Path; |
346 | rmtree( $tmp ); |