1 package MakeMaker::Test::Utils;
7 use vars qw($VERSION @ISA @EXPORT);
14 @EXPORT = qw(which_perl perl_lib makefile_name makefile_backup
15 make make_run run make_macro calibrate_mtime
20 my $Is_VMS = $^O eq 'VMS';
21 my $Is_MacOS = $^O eq 'MacOS';
26 MakeMaker::Test::Utils - Utility routines for testing MakeMaker
30 use MakeMaker::Test::Utils;
32 my $perl = which_perl;
35 my $makefile = makefile_name;
36 my $makefile_back = makefile_backup;
39 my $make_run = make_run;
40 make_macro($make, $targ, %macros);
42 my $mtime = calibrate_mtime;
46 my $have_compiler = have_compiler();
51 A consolidation of little utility functions used through out the
56 The following are exported by default.
62 my $perl = which_perl;
64 Returns a path to perl which is safe to use in a command line, no
65 matter where you chdir to.
73 # VMS should have 'perl' aliased properly
74 return $perl if $Is_VMS;
76 $perl .= $Config{exe_ext} unless $perl =~ m/$Config{exe_ext}$/i;
78 my $perlpath = File::Spec->rel2abs( $perl );
79 unless( $Is_MacOS || -x $perlpath ) {
80 # $^X was probably 'perl'
82 # When building in the core, *don't* go off and find
84 die "Can't find a perl to use (\$^X=$^X), (\$perlpath=$perlpath)"
87 foreach my $path (File::Spec->path) {
88 $perlpath = File::Spec->catfile($path, $perl);
100 Sets up environment variables so perl can find its libraries.
104 my $old5lib = $ENV{PERL5LIB};
105 my $had5lib = exists $ENV{PERL5LIB};
108 my $lib = $ENV{PERL_CORE} ? qq{../lib}
109 # ExtUtils-MakeMaker/t/
111 $lib = File::Spec->rel2abs($lib);
113 push @libs, $ENV{PERL5LIB} if exists $ENV{PERL5LIB};
114 $ENV{PERL5LIB} = join($Config{path_sep}, @libs);
120 $ENV{PERL5LIB} = $old5lib;
123 delete $ENV{PERL5LIB};
128 =item B<makefile_name>
130 my $makefile = makefile_name;
132 MakeMaker doesn't always generate 'Makefile'. It returns what it
138 return $Is_VMS ? 'Descrip.MMS' : 'Makefile';
141 =item B<makefile_backup>
143 my $makefile_old = makefile_backup;
145 Returns the name MakeMaker will use for a backup of the current
150 sub makefile_backup {
151 my $makefile = makefile_name;
152 return $Is_VMS ? "$makefile".'_old' : "$makefile.old";
159 Returns a good guess at the make to run.
164 my $make = $Config{make};
165 $make = $ENV{MAKE} if exists $ENV{MAKE};
172 my $make_run = make_run;
174 Returns the make to run as with make() plus any necessary switches.
180 $make .= ' -nologo' if $make eq 'nmake';
187 my $make_cmd = make_macro($make, $target, %macros);
189 Returns the command necessary to run $make on the given $target using
192 my $make_test_verbose = make_macro(make_run(), 'test',
195 This is important because VMS's make utilities have a completely
196 different calling convention than Unix or Windows.
198 %macros is actually a list of tuples, so the order will be preserved.
203 my($make, $target) = (shift, shift);
205 my $is_mms = $make =~ /^MM(K|S)/i;
209 while( my($key,$val) = splice(@_, 0, 2) ) {
211 $macros .= qq{/macro="$key=$val"};
214 $macros .= qq{ $key=$val};
218 return $is_mms ? "$make$macros $target" : "$make $target $macros";
221 =item B<calibrate_mtime>
223 my $mtime = calibrate_mtime;
225 When building on NFS, file modification times can often lose touch
226 with reality. This returns the mtime of a file which has just been
231 sub calibrate_mtime {
232 open(FILE, ">calibrate_mtime.tmp") || die $!;
235 my($mtime) = (stat('calibrate_mtime.tmp'))[9];
236 unlink 'calibrate_mtime.tmp';
242 my $out = run($command);
243 my @out = run($command);
245 Runs the given $command as an external program returning at least STDOUT
246 as $out. If possible it will return STDOUT and STDERR combined as you
247 would expect to see on a screen.
256 # Unix can handle 2>&1 and OS/2 from 5.005_54 up.
257 # This makes our failure diagnostics nicer to read.
258 if( MM->os_flavor_is('Unix') or
259 ($] > 5.00554 and MM->os_flavor_is('OS/2'))
268 =item B<setup_mm_test_root>
270 Creates a rooted logical to avoid the 8-level limit on older VMS systems.
271 No action taken on non-VMS systems.
275 sub setup_mm_test_root {
277 # On older systems we might exceed the 8-level directory depth limit
278 # imposed by RMS. We get around this with a rooted logical, but we
279 # can't create logical names with attributes in Perl, so we do it
280 # in a DCL subprocess and put it in the job table so the parent sees it.
281 open( MMTMP, '>mmtesttmp.com' ) ||
282 die "Error creating command file; $!";
283 print MMTMP <<'COMMAND';
284 $ MM_TEST_ROOT = F$PARSE("SYS$DISK:[-]",,,,"NO_CONCEAL")-".][000000"-"]["-"].;"+".]"
285 $ DEFINE/JOB/NOLOG/TRANSLATION=CONCEALED MM_TEST_ROOT 'MM_TEST_ROOT'
289 system '@mmtesttmp.com';
290 1 while unlink 'mmtesttmp.com';
296 $have_compiler = have_compiler;
298 Returns true if there is a compiler available for XS builds.
303 my $have_compiler = 0;
305 # ExtUtils::CBuilder prints its compilation lines to the screen.
308 local *STDOUT = *STDOUT;
309 local *STDERR = *STDERR;
311 tie *STDOUT, 'TieOut';
312 tie *STDERR, 'TieOut';
315 require ExtUtils::CBuilder;
316 my $cb = ExtUtils::CBuilder->new;
318 $have_compiler = $cb->have_compiler;
321 return $have_compiler;
329 Michael G Schwern <schwern@pobox.com>