Commit | Line | Data |
f6d6199c |
1 | package MakeMaker::Test::Utils; |
2 | |
3 | use File::Spec; |
4 | use strict; |
5 | use Config; |
6 | |
7 | use vars qw($VERSION @ISA @EXPORT); |
8 | |
9 | require Exporter; |
10 | @ISA = qw(Exporter); |
11 | |
e0678a30 |
12 | $VERSION = 0.02; |
f6d6199c |
13 | |
14 | @EXPORT = qw(which_perl perl_lib makefile_name makefile_backup |
e0678a30 |
15 | make make_run make_macro calibrate_mtime |
f6d6199c |
16 | ); |
17 | |
18 | my $Is_VMS = $^O eq 'VMS'; |
d5201bd2 |
19 | my $Is_MacOS = $^O eq 'MacOS'; |
f6d6199c |
20 | |
21 | |
22 | =head1 NAME |
23 | |
24 | MakeMaker::Test::Utils - Utility routines for testing MakeMaker |
25 | |
26 | =head1 SYNOPSIS |
27 | |
28 | use MakeMaker::Test::Utils; |
29 | |
30 | my $perl = which_perl; |
31 | perl_lib; |
32 | |
33 | my $makefile = makefile_name; |
34 | my $makefile_back = makefile_backup; |
35 | |
36 | my $make = make; |
37 | my $make_run = make_run; |
38 | make_macro($make, $targ, %macros); |
39 | |
e0678a30 |
40 | my $mtime = calibrate_mtime; |
41 | |
f6d6199c |
42 | =head1 DESCRIPTION |
43 | |
44 | A consolidation of little utility functions used through out the |
45 | MakeMaker test suite. |
46 | |
47 | =head2 Functions |
48 | |
49 | The following are exported by default. |
50 | |
51 | =over 4 |
52 | |
53 | =item B<which_perl> |
54 | |
55 | my $perl = which_perl; |
56 | |
57 | Returns a path to perl which is safe to use in a command line, no |
58 | matter where you chdir to. |
59 | |
60 | =cut |
61 | |
62 | sub which_perl { |
63 | my $perl = $^X; |
64 | $perl ||= 'perl'; |
65 | |
66 | # VMS should have 'perl' aliased properly |
67 | return $perl if $Is_VMS; |
68 | |
e0678a30 |
69 | $perl .= $Config{exe_ext} unless $perl =~ m/$Config{exe_ext}$/i; |
f6d6199c |
70 | |
e0678a30 |
71 | my $perlpath = File::Spec->rel2abs( $perl ); |
d5201bd2 |
72 | unless( $Is_MacOS || -x $perlpath ) { |
f6d6199c |
73 | # $^X was probably 'perl' |
e0678a30 |
74 | |
75 | # When building in the core, *don't* go off and find |
76 | # another perl |
77 | die "Can't find a perl to use (\$^X=$^X), (\$perlpath=$perlpath)" |
78 | if $ENV{PERL_CORE}; |
79 | |
f6d6199c |
80 | foreach my $path (File::Spec->path) { |
e0678a30 |
81 | $perlpath = File::Spec->catfile($path, $perl); |
82 | last if -x $perlpath; |
f6d6199c |
83 | } |
84 | } |
85 | |
e0678a30 |
86 | return $perlpath; |
f6d6199c |
87 | } |
88 | |
89 | =item B<perl_lib> |
90 | |
91 | perl_lib; |
92 | |
93 | Sets up environment variables so perl can find its libraries. |
94 | |
95 | =cut |
96 | |
97 | my $old5lib = $ENV{PERL5LIB}; |
98 | my $had5lib = exists $ENV{PERL5LIB}; |
99 | sub perl_lib { |
d2c0d57c |
100 | # perl-src/t/ |
101 | my $lib = $ENV{PERL_CORE} ? qq{../lib} |
102 | # ExtUtils-MakeMaker/t/ |
f6d6199c |
103 | : qq{../blib/lib}; |
104 | $lib = File::Spec->rel2abs($lib); |
105 | my @libs = ($lib); |
106 | push @libs, $ENV{PERL5LIB} if exists $ENV{PERL5LIB}; |
107 | $ENV{PERL5LIB} = join($Config{path_sep}, @libs); |
108 | unshift @INC, $lib; |
109 | } |
110 | |
111 | END { |
112 | if( $had5lib ) { |
113 | $ENV{PERL5LIB} = $old5lib; |
114 | } |
115 | else { |
116 | delete $ENV{PERL5LIB}; |
117 | } |
118 | } |
119 | |
120 | |
121 | =item B<makefile_name> |
122 | |
123 | my $makefile = makefile_name; |
124 | |
125 | MakeMaker doesn't always generate 'Makefile'. It returns what it |
126 | should generate. |
127 | |
128 | =cut |
129 | |
130 | sub makefile_name { |
131 | return $Is_VMS ? 'Descrip.MMS' : 'Makefile'; |
132 | } |
133 | |
134 | =item B<makefile_backup> |
135 | |
136 | my $makefile_old = makefile_backup; |
137 | |
138 | Returns the name MakeMaker will use for a backup of the current |
139 | Makefile. |
140 | |
141 | =cut |
142 | |
143 | sub makefile_backup { |
144 | my $makefile = makefile_name; |
145 | return $Is_VMS ? $makefile : "$makefile.old"; |
146 | } |
147 | |
148 | =item B<make> |
149 | |
150 | my $make = make; |
151 | |
152 | Returns a good guess at the make to run. |
153 | |
154 | =cut |
155 | |
156 | sub make { |
157 | my $make = $Config{make}; |
158 | $make = $ENV{MAKE} if exists $ENV{MAKE}; |
159 | |
160 | return $make; |
161 | } |
162 | |
163 | =item B<make_run> |
164 | |
165 | my $make_run = make_run; |
166 | |
167 | Returns the make to run as with make() plus any necessary switches. |
168 | |
169 | =cut |
170 | |
171 | sub make_run { |
172 | my $make = make; |
173 | $make .= ' -nologo' if $make eq 'nmake'; |
174 | |
175 | return $make; |
176 | } |
177 | |
178 | =item B<make_macro> |
179 | |
180 | my $make_cmd = make_macro($make, $target, %macros); |
181 | |
182 | Returns the command necessary to run $make on the given $target using |
183 | the given %macros. |
184 | |
185 | my $make_test_verbose = make_macro(make_run(), 'test', |
186 | TEST_VERBOSE => 1); |
187 | |
188 | This is important because VMS's make utilities have a completely |
189 | different calling convention than Unix or Windows. |
190 | |
191 | %macros is actually a list of tuples, so the order will be preserved. |
192 | |
193 | =cut |
194 | |
195 | sub make_macro { |
196 | my($make, $target) = (shift, shift); |
197 | |
198 | my $is_mms = $make =~ /^MM(K|S)/i; |
199 | |
200 | my $cmd = $make; |
201 | my $macros = ''; |
202 | while( my($key,$val) = splice(@_, 0, 2) ) { |
203 | if( $is_mms ) { |
204 | $macros .= qq{/macro="$key=$val"}; |
205 | } |
206 | else { |
207 | $macros .= qq{ $key=$val}; |
208 | } |
209 | } |
210 | |
211 | return $is_mms ? "$make$macros $target" : "$make $target $macros"; |
212 | } |
213 | |
e0678a30 |
214 | =item B<calibrate_mtime> |
215 | |
216 | my $mtime = calibrate_mtime; |
217 | |
218 | When building on NFS, file modification times can often lose touch |
219 | with reality. This returns the mtime of a file which has just been |
220 | touched. |
221 | |
222 | =cut |
223 | |
224 | sub calibrate_mtime { |
225 | open(FILE, ">calibrate_mtime.tmp") || die $!; |
226 | print FILE "foo"; |
227 | close FILE; |
228 | my($mtime) = (stat('calibrate_mtime.tmp'))[9]; |
229 | unlink 'calibrate_mtime.tmp'; |
230 | return $mtime; |
231 | } |
232 | |
f6d6199c |
233 | =back |
234 | |
235 | =head1 AUTHOR |
236 | |
237 | Michael G Schwern <schwern@pobox.com> |
238 | |
239 | =cut |
240 | |
241 | 1; |