Updated Module::Build to 0.35_14
[p5sagit/p5-mst-13.2.git] / cpan / Module-Build / t / lib / MBTest.pm
CommitLineData
bb4e9162 1package MBTest;
2
3use strict;
4
53fc1c7e 5use IO::File ();
bb4e9162 6use File::Spec;
66e531b6 7use File::Temp ();
7a827510 8use File::Path ();
bb4e9162 9
15cb7b9d 10
11# Setup the code to clean out %ENV
12BEGIN {
13 # Environment variables which might effect our testing
14 my @delete_env_keys = qw(
15 DEVEL_COVER_OPTIONS
16 MODULEBUILDRC
613f422f 17 PERL_MB_OPT
15cb7b9d 18 HARNESS_TIMER
19 HARNESS_OPTIONS
20 HARNESS_VERBOSE
21 PREFIX
22 INSTALL_BASE
23 INSTALLDIRS
24 );
25
26 # Remember the ENV values because on VMS %ENV is global
27 # to the user, not the process.
28 my %restore_env_keys;
29
30 sub clean_env {
31 for my $key (@delete_env_keys) {
32 if( exists $ENV{$key} ) {
33 $restore_env_keys{$key} = delete $ENV{$key};
34 }
35 else {
36 delete $ENV{$key};
37 }
38 }
39 }
40
41 END {
42 while( my($key, $val) = each %restore_env_keys ) {
43 $ENV{$key} = $val;
44 }
45 }
46}
47
48
bb4e9162 49BEGIN {
15cb7b9d 50 clean_env();
bb4e9162 51
738349a8 52 # In case the test wants to use our other bundled
53 # modules, make sure they can be loaded.
613f422f 54 my $t_lib = File::Spec->catdir('t', 'bundled');
55 push @INC, $t_lib; # Let user's installed version override
56
57 if ($ENV{PERL_CORE}) {
58 # We change directories, so expand @INC and $^X to absolute paths
59 # Also add .
60 @INC = (map(File::Spec->rel2abs($_), @INC), ".");
61 $^X = File::Spec->rel2abs($^X);
62 }
bb4e9162 63}
64
65use Exporter;
66use Test::More;
67use Config;
7a827510 68use Cwd ();
bb4e9162 69
70# We pass everything through to Test::More
71use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
66e531b6 72$VERSION = 0.01_01;
bb4e9162 73@ISA = qw(Test::More); # Test::More isa Exporter
74@EXPORT = @Test::More::EXPORT;
75%EXPORT_TAGS = %Test::More::EXPORT_TAGS;
76
77# We have a few extra exports, but Test::More has a special import()
78# that won't take extra additions.
7a827510 79my @extra_exports = qw(
80 stdout_of
81 stderr_of
82 stdout_stderr_of
83 slurp
84 find_in_path
85 check_compiler
86 have_module
613f422f 87 blib_load
53fc1c7e 88 timed_out
7a827510 89);
bb4e9162 90push @EXPORT, @extra_exports;
91__PACKAGE__->export(scalar caller, @extra_exports);
7a827510 92# XXX ^-- that should really happen in import()
15cb7b9d 93
94
7a827510 95########################################################################
96
66e531b6 97# always return to the current directory
08fc25ad 98{
613f422f 99 my $cwd = File::Spec->rel2abs(Cwd::cwd);
100
101 sub original_cwd { return $cwd }
7a827510 102
7a827510 103 END {
66e531b6 104 # Go back to where you came from!
105 chdir $cwd or die "Couldn't chdir to $cwd";
7a827510 106 }
107}
108########################################################################
bb4e9162 109
7a827510 110{ # backwards compatible temp filename recipe adapted from perlfaq
111 my $tmp_count = 0;
53fc1c7e 112 my $tmp_base_name = sprintf("MB-%d-%d", $$, time());
7a827510 113 sub temp_file_name {
114 sprintf("%s-%04d", $tmp_base_name, ++$tmp_count)
115 }
116}
117########################################################################
bb4e9162 118
613f422f 119# Setup a temp directory
120sub tmpdir {
121 my ($self, @args) = @_;
122 my $dir = $ENV{PERL_CORE} ? MBTest->original_cwd : File::Spec->tmpdir;
123 return File::Temp::tempdir('MB-XXXXXXXX', CLEANUP => 1, DIR => $dir, @args);
66e531b6 124}
125
bb4e9162 126sub save_handle {
127 my ($handle, $subr) = @_;
53fc1c7e 128 my $outfile = File::Spec->catfile(File::Spec->tmpdir, temp_file_name());
bb4e9162 129
130 local *SAVEOUT;
7a827510 131 open SAVEOUT, ">&" . fileno($handle)
132 or die "Can't save output handle: $!";
bb4e9162 133 open $handle, "> $outfile" or die "Can't create $outfile: $!";
134
135 eval {$subr->()};
136 open $handle, ">&SAVEOUT" or die "Can't restore output: $!";
137
138 my $ret = slurp($outfile);
139 1 while unlink $outfile;
140 return $ret;
141}
142
143sub stdout_of { save_handle(\*STDOUT, @_) }
144sub stderr_of { save_handle(\*STDERR, @_) }
7a827510 145sub stdout_stderr_of {
146 my $subr = shift;
147 my ($stdout, $stderr);
148 $stdout = stdout_of ( sub {
149 $stderr = stderr_of( $subr )
150 });
613f422f 151 return wantarray ? ($stdout, $stderr) : $stdout . $stderr;
7a827510 152}
bb4e9162 153
154sub slurp {
155 my $fh = IO::File->new($_[0]) or die "Can't open $_[0]: $!";
156 local $/;
157 return scalar <$fh>;
158}
159
7a827510 160# Some extensions we should know about if we're looking for executables
7253302f 161sub exe_exts {
7253302f 162
163 if ($^O eq 'MSWin32') {
164 return split($Config{path_sep}, $ENV{PATHEXT} || '.com;.exe;.bat');
165 }
166 if ($^O eq 'os2') {
167 return qw(.exe .com .pl .cmd .bat .sh .ksh);
168 }
169 return;
170}
171
bb4e9162 172sub find_in_path {
173 my $thing = shift;
613f422f 174
7253302f 175 my @exe_ext = exe_exts();
613f422f 176 if ( File::Spec->file_name_is_absolute( $thing ) ) {
7253302f 177 foreach my $ext ( '', @exe_ext ) {
613f422f 178 return "$thing$ext" if -e "$thing$ext";
179 }
180 }
181 else {
182 my @path = split $Config{path_sep}, $ENV{PATH};
183 foreach (@path) {
184 my $fullpath = File::Spec->catfile($_, $thing);
185 foreach my $ext ( '', @exe_ext ) {
186 return "$fullpath$ext" if -e "$fullpath$ext";
187 }
bb4e9162 188 }
189 }
190 return;
191}
192
bb4e9162 193sub check_compiler {
194 return (1,1) if $ENV{PERL_CORE};
195
196 local $SIG{__WARN__} = sub {};
197
613f422f 198 blib_load('Module::Build');
bb4e9162 199 my $mb = Module::Build->current;
200 $mb->verbose( 0 );
201
202 my $have_c_compiler;
203 stderr_of( sub {$have_c_compiler = $mb->have_c_compiler} );
204
cdbde1c3 205 # check noexec tmpdir
206 my $tmp_exec;
207 if ( $have_c_compiler ) {
208 my $dir = MBTest->tmpdir;
209 my $c_file = File::Spec->catfile($dir,'test.c');
210 open my $fh, ">", $c_file;
211 print {$fh} "int main() { return 0; }\n";
212 close $fh;
213 my $exe = $mb->cbuilder->link_executable(
214 objects => $mb->cbuilder->compile( source => $c_file )
215 );
216 $tmp_exec = 0 == system( $exe );
217 }
08fc25ad 218 return ($have_c_compiler, $tmp_exec);
bb4e9162 219}
220
f943a5bf 221sub have_module {
222 my $module = shift;
613f422f 223 return eval "require $module; 1";
f943a5bf 224}
225
613f422f 226sub blib_load {
227 # Load the given module and ensure it came from blib/, not the larger system
738349a8 228 my $mod = shift;
613f422f 229 have_module($mod) or die "Error loading $mod\: $@\n";
230
738349a8 231 (my $path = $mod) =~ s{::}{/}g;
613f422f 232 $path .= ".pm";
233 my ($pkg, $file, $line) = caller;
234 unless($ENV{PERL_CORE}) {
235 unless($INC{$path} =~ m/\bblib\b/) {
236 (my $load_from = $INC{$path}) =~ s{$path$}{};
237 die "$mod loaded from '$load_from'\nIt should have been loaded from blib. \@INC contains:\n ",
238 join("\n ", @INC) . "\nFatal error occured in blib_load() at $file, line $line.\n";
239 }
738349a8 240 }
241}
242
53fc1c7e 243sub timed_out {
244 my ($sub, $timeout) = @_;
245 return unless $sub;
246 $timeout ||= 60;
247
248 my $saw_alarm = 0;
249 eval {
250 local $SIG{ALRM} = sub { $saw_alarm++; die "alarm\n"; }; # NB: \n required
251 alarm $timeout;
252 $sub->();
253 alarm 0;
254 };
255 if ($@) {
256 die unless $@ eq "alarm\n"; # propagate unexpected errors
257 }
258 return $saw_alarm;
259}
260
261sub check_EUI {
262 my $timed_out;
263 stdout_stderr_of( sub {
264 $timed_out = timed_out( sub {
265 ExtUtils::Installed->new(extra_libs => [@INC])
266 }
267 );
268 }
269 );
270 return ! $timed_out;
271}
272
bb4e9162 2731;
7a827510 274# vim:ts=2:sw=2:et:sta