1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
|
package MakeMaker::Test::Utils;
use File::Spec;
use strict;
use Config;
require Exporter;
our @ISA = qw(Exporter);
our $Is_VMS = $^O eq 'VMS';
our $Is_MacOS = $^O eq 'MacOS';
our @EXPORT = qw(which_perl perl_lib makefile_name makefile_backup
make make_run run make_macro calibrate_mtime
have_compiler slurp
$Is_VMS $Is_MacOS
run_ok
);
# Setup the code to clean out %ENV
{
# Environment variables which might effect our testing
my @delete_env_keys = qw(
PERL_MM_OPT
PERL_MM_USE_DEFAULT
HARNESS_TIMER
HARNESS_OPTIONS
HARNESS_VERBOSE
PREFIX
MAKEFLAGS
);
# Remember the ENV values because on VMS %ENV is global
# to the user, not the process.
my %restore_env_keys;
sub clean_env {
for my $key (@delete_env_keys) {
if( exists $ENV{$key} ) {
$restore_env_keys{$key} = delete $ENV{$key};
}
else {
delete $ENV{$key};
}
}
}
END {
while( my($key, $val) = each %restore_env_keys ) {
$ENV{$key} = $val;
}
}
}
clean_env();
=head1 NAME
MakeMaker::Test::Utils - Utility routines for testing MakeMaker
=head1 SYNOPSIS
use MakeMaker::Test::Utils;
my $perl = which_perl;
perl_lib;
my $makefile = makefile_name;
my $makefile_back = makefile_backup;
my $make = make;
my $make_run = make_run;
make_macro($make, $targ, %macros);
my $mtime = calibrate_mtime;
my $out = run($cmd);
my $have_compiler = have_compiler();
my $text = slurp($filename);
=head1 DESCRIPTION
A consolidation of little utility functions used through out the
MakeMaker test suite.
=head2 Functions
The following are exported by default.
=over 4
=item B<which_perl>
my $perl = which_perl;
Returns a path to perl which is safe to use in a command line, no
matter where you chdir to.
=cut
sub which_perl {
my $perl = $^X;
$perl ||= 'perl';
# VMS should have 'perl' aliased properly
return $perl if $Is_VMS;
$perl .= $Config{exe_ext} unless $perl =~ m/$Config{exe_ext}$/i;
my $perlpath = File::Spec->rel2abs( $perl );
unless( $Is_MacOS || -x $perlpath ) {
# $^X was probably 'perl'
# When building in the core, *don't* go off and find
# another perl
die "Can't find a perl to use (\$^X=$^X), (\$perlpath=$perlpath)"
if $ENV{PERL_CORE};
foreach my $path (File::Spec->path) {
$perlpath = File::Spec->catfile($path, $perl);
last if -x $perlpath;
}
}
return $perlpath;
}
=item B<perl_lib>
perl_lib;
Sets up environment variables so perl can find its libraries.
Run this before changing directories.
=cut
my $old5lib = $ENV{PERL5LIB};
my $had5lib = exists $ENV{PERL5LIB};
sub perl_lib {
if ($ENV{PERL_CORE}) {
# Whilst we'll be running in perl-src/cpan/$distname/t/
# instead of blib, our code will be copied with all the other code to
# the top-level library.
# $ENV{PERL5LIB} will be set with this, but (by default) it's a relative
# path.
$ENV{PERL5LIB} = join $Config{path_sep}, map {
File::Spec->rel2abs($_) } split quotemeta($Config{path_sep}), $ENV{PERL5LIB};
@INC = map { File::Spec->rel2abs($_) } @INC;
} else {
my $lib = 'blib/lib';
$lib = File::Spec->rel2abs($lib);
my @libs = ($lib);
push @libs, $ENV{PERL5LIB} if exists $ENV{PERL5LIB};
$ENV{PERL5LIB} = join($Config{path_sep}, @libs);
unshift @INC, $lib;
}
}
END {
if( $had5lib ) {
$ENV{PERL5LIB} = $old5lib;
}
else {
delete $ENV{PERL5LIB};
}
}
=item B<makefile_name>
my $makefile = makefile_name;
MakeMaker doesn't always generate 'Makefile'. It returns what it
should generate.
=cut
sub makefile_name {
return $Is_VMS ? 'Descrip.MMS' : 'Makefile';
}
=item B<makefile_backup>
my $makefile_old = makefile_backup;
Returns the name MakeMaker will use for a backup of the current
Makefile.
=cut
sub makefile_backup {
my $makefile = makefile_name;
return $Is_VMS ? "$makefile".'_old' : "$makefile.old";
}
=item B<make>
my $make = make;
Returns a good guess at the make to run.
=cut
sub make {
my $make = $Config{make};
$make = $ENV{MAKE} if exists $ENV{MAKE};
return if !can_run($make);
return $make;
}
=item B<make_run>
my $make_run = make_run;
Returns the make to run as with make() plus any necessary switches.
=cut
sub make_run {
my $make = make;
return if !$make;
$make .= ' -nologo' if $make eq 'nmake';
return $make;
}
=item B<make_macro>
my $make_cmd = make_macro($make, $target, %macros);
Returns the command necessary to run $make on the given $target using
the given %macros.
my $make_test_verbose = make_macro(make_run(), 'test',
TEST_VERBOSE => 1);
This is important because VMS's make utilities have a completely
different calling convention than Unix or Windows.
%macros is actually a list of tuples, so the order will be preserved.
=cut
sub make_macro {
my($make, $target) = (shift, shift);
my $is_mms = $make =~ /^MM(K|S)/i;
my $cmd = $make;
my $macros = '';
while( my($key,$val) = splice(@_, 0, 2) ) {
if( $is_mms ) {
$macros .= qq{/macro="$key=$val"};
}
else {
$macros .= qq{ $key=$val};
}
}
return $is_mms ? "$make$macros $target" : "$make $target $macros";
}
=item B<calibrate_mtime>
my $mtime = calibrate_mtime;
When building on NFS, file modification times can often lose touch
with reality. This returns the mtime of a file which has just been
touched.
=cut
sub calibrate_mtime {
open(FILE, ">calibrate_mtime.tmp") || die $!;
print FILE "foo";
close FILE;
my($mtime) = (stat('calibrate_mtime.tmp'))[9];
unlink 'calibrate_mtime.tmp';
return $mtime;
}
=item B<run>
my $out = run($command);
my @out = run($command);
Runs the given $command as an external program returning at least STDOUT
as $out. If possible it will return STDOUT and STDERR combined as you
would expect to see on a screen.
=cut
sub run {
my $cmd = shift;
use ExtUtils::MM;
# Unix, modern Windows and OS/2 from 5.005_54 up can handle can handle 2>&1
# This makes our failure diagnostics nicer to read.
if( MM->os_flavor_is('Unix') or
(MM->os_flavor_is('Win32') and !MM->os_flavor_is('Win9x')) or
($] > 5.00554 and MM->os_flavor_is('OS/2'))
) {
return `$cmd 2>&1`;
}
else {
return `$cmd`;
}
}
=item B<run_ok>
my @out = run_ok($cmd);
Like run() but it tests that the result exited normally.
The output from run() will be used as a diagnostic if it fails.
=cut
sub run_ok {
my $tb = Test::Builder->new;
my @out = run(@_);
$tb->cmp_ok( $?, '==', 0, "run(@_)" ) || $tb->diag(@out);
return wantarray ? @out : join "", @out;
}
=item have_compiler
$have_compiler = have_compiler;
Returns true if there is a compiler available for XS builds.
=cut
sub have_compiler {
my $have_compiler = 0;
# ExtUtils::CBuilder prints its compilation lines to the screen.
# Shut it up.
use TieOut;
local *STDOUT = *STDOUT;
local *STDERR = *STDERR;
tie *STDOUT, 'TieOut';
tie *STDERR, 'TieOut';
eval {
require ExtUtils::CBuilder;
my $cb = ExtUtils::CBuilder->new;
$have_compiler = $cb->have_compiler;
};
return $have_compiler;
}
=item slurp
$contents = slurp($filename);
Returns the $contents of $filename.
Will die if $filename cannot be opened.
=cut
sub slurp {
my $filename = shift;
local $/ = undef;
open my $fh, $filename or die "Can't open $filename for reading: $!";
my $text = <$fh>;
close $fh;
return $text;
}
=item can_run
C<can_run> takes only one argument: the name of a binary you wish
to locate. C<can_run> works much like the unix binary C<which> or the bash
command C<type>, which scans through your path, looking for the requested
binary.
Unlike C<which> and C<type>, this function is platform independent and
will also work on, for example, Win32.
If called in a scalar context it will return the full path to the binary
you asked for if it was found, or C<undef> if it was not.
If called in a list context and the global variable C<$INSTANCES> is a true
value, it will return a list of the full paths to instances
of the binary where found in C<PATH>, or an empty list if it was not found.
=cut
sub can_run {
my $command = shift;
# a lot of VMS executables have a symbol defined
# check those first
if ( $^O eq 'VMS' ) {
require VMS::DCLsym;
my $syms = VMS::DCLsym->new;
return $command if scalar $syms->getsym( uc $command );
}
require File::Spec;
require ExtUtils::MakeMaker;
my @possibles;
if( File::Spec->file_name_is_absolute($command) ) {
return MM->maybe_command($command);
} else {
for my $dir (
File::Spec->path,
File::Spec->curdir
) {
next if ! $dir || ! -d $dir;
my $abs = File::Spec->catfile( $^O eq 'MSWin32' ? Win32::GetShortPathName( $dir ) : $dir, $command);
push @possibles, $abs if $abs = MM->maybe_command($abs);
}
}
return @possibles if wantarray;
return shift @possibles;
}
=back
=head1 AUTHOR
Michael G Schwern <schwern@pobox.com>
=cut
1;
|