Commit | Line | Data |
---|---|---|
bb4e9162 YST |
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; | |
7 | use Config; | |
8 | ||
9 | # Don't let our own verbosity/test_file get mixed up with our subprocess's | |
10 | my @makefile_keys = qw(TEST_VERBOSE HARNESS_VERBOSE TEST_FILES MAKEFLAGS); | |
11 | local @ENV{@makefile_keys}; | |
12 | delete @ENV{@makefile_keys}; | |
13 | ||
14 | my @makefile_types = qw(small passthrough traditional); | |
15 | my $tests_per_type = 10; | |
16 | if ( $Config{make} && find_in_path($Config{make}) ) { | |
17 | plan tests => 30 + @makefile_types*$tests_per_type; | |
18 | } else { | |
19 | plan skip_all => "Don't know how to invoke 'make'"; | |
20 | } | |
21 | ok(1); # Loaded | |
22 | ||
23 | ||
24 | ######################### | |
25 | ||
26 | use Cwd (); | |
27 | my $cwd = Cwd::cwd; | |
28 | my $tmp = File::Spec->catdir( $cwd, 't', '_tmp' ); | |
29 | ||
30 | use DistGen; | |
31 | my $dist = DistGen->new( dir => $tmp ); | |
32 | $dist->regen; | |
33 | ||
34 | chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!"; | |
35 | ||
36 | ||
37 | ######################### | |
38 | ||
39 | use Module::Build; | |
40 | use Module::Build::Compat; | |
41 | ||
42 | use Carp; $SIG{__WARN__} = \&Carp::cluck; | |
43 | ||
44 | my @make = $Config{make} eq 'nmake' ? ('nmake', '-nologo') : ($Config{make}); | |
45 | ||
46 | ######################### | |
47 | ||
48 | ||
49 | my $mb = Module::Build->new_from_context; | |
50 | ok $mb; | |
51 | ||
52 | foreach my $type (@makefile_types) { | |
53 | Module::Build::Compat->create_makefile_pl($type, $mb); | |
54 | test_makefile_creation($mb); | |
55 | ||
56 | ok $mb->do_system(@make); | |
57 | ||
58 | # Can't let 'test' STDOUT go to our STDOUT, or it'll confuse Test::Harness. | |
59 | my $success; | |
60 | my $output = stdout_of( sub { | |
61 | $success = $mb->do_system(@make, 'test'); | |
62 | } ); | |
63 | ok $success; | |
64 | like uc $output, qr{DONE\.|SUCCESS}; | |
65 | ||
66 | ok $mb->do_system(@make, 'realclean'); | |
67 | ||
68 | # Try again with some Makefile.PL arguments | |
69 | test_makefile_creation($mb, [], 'INSTALLDIRS=vendor', 1); | |
70 | ||
71 | 1 while unlink 'Makefile.PL'; | |
72 | ok ! -e 'Makefile.PL'; | |
73 | } | |
74 | ||
75 | { | |
76 | # Make sure fake_makefile() can run without 'build_class', as it may be | |
77 | # in older-generated Makefile.PLs | |
78 | my $warning = ''; | |
79 | local $SIG{__WARN__} = sub { $warning = shift; }; | |
80 | my $maketext = eval { Module::Build::Compat->fake_makefile(makefile => 'Makefile') }; | |
81 | is $@, ''; | |
82 | like $maketext, qr/^realclean/m; | |
83 | like $warning, qr/build_class/; | |
84 | } | |
85 | ||
86 | { | |
87 | # Make sure custom builder subclass is used in the created | |
88 | # Makefile.PL - make sure it fails in the right way here. | |
89 | local @Foo::Builder::ISA = qw(Module::Build); | |
90 | my $foo_builder = Foo::Builder->new_from_context; | |
91 | foreach my $style ('passthrough', 'small') { | |
92 | Module::Build::Compat->create_makefile_pl($style, $foo_builder); | |
93 | ok -e 'Makefile.PL'; | |
94 | ||
95 | # Should fail with "can't find Foo/Builder.pm" | |
96 | my $warning = stderr_of | |
97 | (sub { | |
98 | my $result = $mb->run_perl_script('Makefile.PL'); | |
99 | ok ! $result; | |
100 | }); | |
101 | like $warning, qr{Foo/Builder.pm}; | |
102 | } | |
103 | ||
104 | # Now make sure it can actually work. | |
105 | my $bar_builder = Module::Build->subclass( class => 'Bar::Builder' )->new_from_context; | |
106 | foreach my $style ('passthrough', 'small') { | |
107 | Module::Build::Compat->create_makefile_pl($style, $bar_builder); | |
108 | ok -e 'Makefile.PL'; | |
109 | ok $mb->run_perl_script('Makefile.PL'); | |
110 | } | |
111 | } | |
112 | ||
113 | { | |
114 | # Make sure various Makefile.PL arguments are supported | |
115 | Module::Build::Compat->create_makefile_pl('passthrough', $mb); | |
116 | ||
117 | my $libdir = File::Spec->catdir( $cwd, 't', 'libdir' ); | |
118 | my $result = $mb->run_perl_script('Makefile.PL', [], | |
119 | [ | |
120 | "LIB=$libdir", | |
121 | 'TEST_VERBOSE=1', | |
122 | 'INSTALLDIRS=perl', | |
123 | 'POLLUTE=1', | |
124 | ] | |
125 | ); | |
126 | ok $result; | |
127 | ok -e 'Build.PL'; | |
128 | ||
129 | my $new_build = Module::Build->resume(); | |
130 | is $new_build->installdirs, 'core'; | |
131 | is $new_build->verbose, 1; | |
132 | is $new_build->install_destination('lib'), $libdir; | |
133 | is $new_build->extra_compiler_flags->[0], '-DPERL_POLLUTE'; | |
134 | ||
135 | # Make sure those switches actually had an effect | |
136 | my ($ran_ok, $output); | |
137 | $output = stdout_of( sub { $ran_ok = $new_build->do_system(@make, 'test') } ); | |
138 | ok $ran_ok; | |
139 | $output =~ s/^/# /gm; # Don't confuse our own test output | |
140 | like $output, qr/(?:# ok \d+\s+)+/, 'Should be verbose'; | |
141 | ||
142 | # Make sure various Makefile arguments are supported | |
143 | $output = stdout_of( sub { $ran_ok = $mb->do_system(@make, 'test', 'TEST_VERBOSE=0') } ); | |
144 | ok $ran_ok; | |
145 | $output =~ s/^/# /gm; # Don't confuse our own test output | |
97f4a048 | 146 | like $output, qr/(?:# .+basic\.+ok\s+(?:[\d.]+s\s*)?)# All tests/, |
bb4e9162 YST |
147 | 'Should be non-verbose'; |
148 | ||
149 | $mb->delete_filetree($libdir); | |
150 | ok ! -e $libdir, "Sample installation directory should be cleaned up"; | |
151 | ||
152 | $mb->do_system(@make, 'realclean'); | |
153 | ok ! -e 'Makefile', "Makefile shouldn't exist"; | |
154 | ||
155 | 1 while unlink 'Makefile.PL'; | |
156 | ok ! -e 'Makefile.PL'; | |
157 | } | |
158 | ||
159 | { # Make sure tilde-expansion works | |
160 | ||
161 | # C<glob> on MSWin32 uses $ENV{HOME} if defined to do tilde-expansion | |
162 | local $ENV{HOME} = 'C:/' if $^O =~ /MSWin/ && !exists( $ENV{HOME} ); | |
163 | ||
164 | Module::Build::Compat->create_makefile_pl('passthrough', $mb); | |
165 | ||
166 | $mb->run_perl_script('Makefile.PL', [], ['INSTALL_BASE=~/foo']); | |
167 | my $b2 = Module::Build->current; | |
168 | ok $b2->install_base; | |
169 | unlike $b2->install_base, qr/^~/, "Tildes should be expanded"; | |
170 | ||
171 | $mb->do_system(@make, 'realclean'); | |
172 | 1 while unlink 'Makefile.PL'; | |
173 | } | |
174 | ######################################################### | |
175 | ||
176 | sub test_makefile_creation { | |
177 | my ($build, $preargs, $postargs, $cleanup) = @_; | |
178 | ||
179 | my $result = $build->run_perl_script('Makefile.PL', $preargs, $postargs); | |
180 | ok $result; | |
181 | ok -e 'Makefile', "Makefile should exist"; | |
182 | ||
183 | if ($cleanup) { | |
184 | $build->do_system(@make, 'realclean'); | |
185 | ok ! -e 'Makefile', "Makefile shouldn't exist"; | |
186 | } | |
187 | } | |
188 | ||
189 | ||
190 | # cleanup | |
191 | chdir( $cwd ) or die "Can''t chdir to '$cwd': $!"; | |
192 | $dist->remove; | |
193 | ||
194 | use File::Path; | |
195 | rmtree( $tmp ); |