11 # Setup the code to clean out %ENV
13 # Environment variables which might effect our testing
14 my @delete_env_keys = qw(
27 # Remember the ENV values because on VMS %ENV is global
28 # to the user, not the process.
32 for my $key (@delete_env_keys) {
33 if( exists $ENV{$key} ) {
34 $restore_env_keys{$key} = delete $ENV{$key};
43 while( my($key, $val) = each %restore_env_keys ) {
53 # In case the test wants to use our other bundled
54 # modules, make sure they can be loaded.
55 my $t_lib = File::Spec->catdir('t', 'bundled');
56 push @INC, $t_lib; # Let user's installed version override
58 if ($ENV{PERL_CORE}) {
59 # We change directories, so expand @INC and $^X to absolute paths
61 @INC = (map(File::Spec->rel2abs($_), @INC), ".");
62 $^X = File::Spec->rel2abs($^X);
71 # We pass everything through to Test::More
72 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
74 @ISA = qw(Test::More); # Test::More isa Exporter
75 @EXPORT = @Test::More::EXPORT;
76 %EXPORT_TAGS = %Test::More::EXPORT_TAGS;
78 # We have a few extra exports, but Test::More has a special import()
79 # that won't take extra additions.
80 my @extra_exports = qw(
91 push @EXPORT, @extra_exports;
92 __PACKAGE__->export(scalar caller, @extra_exports);
93 # XXX ^-- that should really happen in import()
96 ########################################################################
98 # always return to the current directory
100 my $cwd = File::Spec->rel2abs(Cwd::cwd);
102 sub original_cwd { return $cwd }
105 # Go back to where you came from!
106 chdir $cwd or die "Couldn't chdir to $cwd";
109 ########################################################################
111 { # backwards compatible temp filename recipe adapted from perlfaq
113 my $tmp_base_name = sprintf("MB-%d-%d", $$, time());
115 sprintf("%s-%04d", $tmp_base_name, ++$tmp_count)
118 ########################################################################
120 # Setup a temp directory
122 my ($self, @args) = @_;
123 my $dir = $ENV{PERL_CORE} ? MBTest->original_cwd : File::Spec->tmpdir;
124 return File::Temp::tempdir('MB-XXXXXXXX', CLEANUP => 1, DIR => $dir, @args);
128 $ENV{HOME} = tmpdir; # don't want .modulebuildrc or other things interfering
132 my ($handle, $subr) = @_;
133 my $outfile = File::Spec->catfile(File::Spec->tmpdir, temp_file_name());
136 open SAVEOUT, ">&" . fileno($handle)
137 or die "Can't save output handle: $!";
138 open $handle, "> $outfile" or die "Can't create $outfile: $!";
141 open $handle, ">&SAVEOUT" or die "Can't restore output: $!";
143 my $ret = slurp($outfile);
144 1 while unlink $outfile;
148 sub stdout_of { save_handle(\*STDOUT, @_) }
149 sub stderr_of { save_handle(\*STDERR, @_) }
150 sub stdout_stderr_of {
152 my ($stdout, $stderr);
153 $stdout = stdout_of ( sub {
154 $stderr = stderr_of( $subr )
156 return wantarray ? ($stdout, $stderr) : $stdout . $stderr;
160 my $fh = IO::File->new($_[0]) or die "Can't open $_[0]: $!";
165 # Some extensions we should know about if we're looking for executables
168 if ($^O eq 'MSWin32') {
169 return split($Config{path_sep}, $ENV{PATHEXT} || '.com;.exe;.bat');
172 return qw(.exe .com .pl .cmd .bat .sh .ksh);
180 my @exe_ext = exe_exts();
181 if ( File::Spec->file_name_is_absolute( $thing ) ) {
182 foreach my $ext ( '', @exe_ext ) {
183 return "$thing$ext" if -e "$thing$ext";
187 my @path = split $Config{path_sep}, $ENV{PATH};
189 my $fullpath = File::Spec->catfile($_, $thing);
190 foreach my $ext ( '', @exe_ext ) {
191 return "$fullpath$ext" if -e "$fullpath$ext";
199 return (1,1) if $ENV{PERL_CORE};
201 local $SIG{__WARN__} = sub {};
203 blib_load('Module::Build');
204 my $mb = Module::Build->current;
208 stderr_of( sub {$have_c_compiler = $mb->have_c_compiler} );
210 # check noexec tmpdir
212 if ( $have_c_compiler ) {
213 my $dir = MBTest->tmpdir;
214 my $c_file = File::Spec->catfile($dir,'test.c');
215 open my $fh, ">", $c_file;
216 print {$fh} "int main() { return 0; }\n";
218 my $exe = $mb->cbuilder->link_executable(
219 objects => $mb->cbuilder->compile( source => $c_file )
221 $tmp_exec = 0 == system( $exe );
223 return ($have_c_compiler, $tmp_exec);
228 return eval "require $module; 1";
232 # Load the given module and ensure it came from blib/, not the larger system
234 have_module($mod) or die "Error loading $mod\: $@\n";
236 (my $path = $mod) =~ s{::}{/}g;
238 my ($pkg, $file, $line) = caller;
239 unless($ENV{PERL_CORE}) {
240 unless($INC{$path} =~ m/\bblib\b/) {
241 (my $load_from = $INC{$path}) =~ s{$path$}{};
242 die "$mod loaded from '$load_from'\nIt should have been loaded from blib. \@INC contains:\n ",
243 join("\n ", @INC) . "\nFatal error occured in blib_load() at $file, line $line.\n";
249 my ($sub, $timeout) = @_;
255 local $SIG{ALRM} = sub { $saw_alarm++; die "alarm\n"; }; # NB: \n required
261 die unless $@ eq "alarm\n"; # propagate unexpected errors
268 stdout_stderr_of( sub {
269 $timed_out = timed_out( sub {
270 ExtUtils::Installed->new(extra_libs => [@INC])
279 # vim:ts=2:sw=2:et:sta