Commit | Line | Data |
---|---|---|
6a8dbfd7 NC |
1 | #!/usr/bin/perl -w |
2 | use strict; | |
3 | ||
e295b7be | 4 | use Getopt::Long qw(:config bundling); |
6a8dbfd7 | 5 | |
4daf2803 | 6 | my @targets = qw(miniperl lib/Config.pm perl test_prep); |
6a8dbfd7 | 7 | |
f4800c99 NC |
8 | my %options = |
9 | ( | |
10 | target => 'test_prep', | |
11 | jobs => 9, | |
12 | 'expect-pass' => 1, | |
13 | clean => 1, # mostly for debugging this | |
14 | ); | |
6a8dbfd7 NC |
15 | |
16 | sub usage { | |
e295b7be | 17 | die "$0: [--target=...] [-j4] [--expect-pass=0|1] thing to test"; |
6a8dbfd7 NC |
18 | } |
19 | ||
f4800c99 NC |
20 | unless(GetOptions(\%options, |
21 | 'target=s', 'jobs|j=i', 'expect-pass=i', | |
22 | 'expect-fail' => sub { $options{'expect-pass'} = 0; }, | |
23 | 'clean!', 'one-liner|e=s', 'match=s', 'force-manifest', | |
24 | 'test-build', 'check-args', | |
6a8dbfd7 NC |
25 | )) { |
26 | usage(); | |
27 | } | |
28 | ||
f4800c99 | 29 | my ($target, $j, $match) = @options{qw(target jobs match)}; |
e295b7be | 30 | |
4daf2803 NC |
31 | my $exe = $target eq 'perl' || $target eq 'test_prep' ? 'perl' : 'miniperl'; |
32 | my $expected = $target eq 'test_prep' ? 'perl' : $target; | |
6a8dbfd7 | 33 | |
f4800c99 NC |
34 | unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'} |
35 | if $options{'one-liner'}; | |
6a8dbfd7 | 36 | |
f4800c99 NC |
37 | usage() unless @ARGV || $match || $options{'test-build'}; |
38 | exit 0 if $options{'check-args'}; | |
6a8dbfd7 NC |
39 | |
40 | die "$0: Can't build $target" unless grep {@targets} $target; | |
41 | ||
42 | $j = "-j$j" if $j =~ /\A\d+\z/; | |
43 | ||
0142f0ce NC |
44 | # Sadly, however hard we try, I don't think that it will be possible to build |
45 | # modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29, | |
46 | # which updated to MakeMaker 3.7, which changed from using a hard coded ld | |
47 | # in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc. | |
48 | ||
6a8dbfd7 NC |
49 | sub extract_from_file { |
50 | my ($file, $rx, $default) = @_; | |
51 | open my $fh, '<', $file or die "Can't open $file: $!"; | |
52 | while (<$fh>) { | |
53 | my @got = $_ =~ $rx; | |
54 | return wantarray ? @got : $got[0] | |
55 | if @got; | |
56 | } | |
57 | return $default if defined $default; | |
58 | return; | |
59 | } | |
60 | ||
ab4a15f9 | 61 | sub clean { |
f4800c99 | 62 | if ($options{clean}) { |
ab4a15f9 NC |
63 | # Needed, because files that are build products in this checked out |
64 | # version might be in git in the next desired version. | |
65 | system 'git clean -dxf'; | |
66 | # Needed, because at some revisions the build alters checked out files. | |
67 | # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH | |
68 | system 'git reset --hard HEAD'; | |
69 | } | |
70 | } | |
71 | ||
72 | sub skip { | |
73 | my $reason = shift; | |
74 | clean(); | |
75 | warn "skipping - $reason"; | |
76 | exit 125; | |
77 | } | |
78 | ||
f1050811 NC |
79 | sub report_and_exit { |
80 | my ($ret, $pass, $fail, $desc) = @_; | |
81 | ||
82 | clean(); | |
83 | ||
f4800c99 | 84 | my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad'; |
f1050811 NC |
85 | if ($ret) { |
86 | print "$got - $fail $desc\n"; | |
87 | } else { | |
88 | print "$got - $pass $desc\n"; | |
89 | } | |
90 | ||
91 | exit($got eq 'bad'); | |
92 | } | |
93 | ||
0142f0ce NC |
94 | sub apply_patch { |
95 | my $patch = shift; | |
96 | ||
97 | open my $fh, '|-', 'patch' or die "Can't run patch: $!"; | |
98 | print $fh $patch; | |
99 | close $fh or die "Can't patch perl.c: $?, $!"; | |
100 | } | |
101 | ||
6a8dbfd7 NC |
102 | # Not going to assume that system perl is yet new enough to have autodie |
103 | system 'git clean -dxf' and die; | |
104 | ||
bc96a05a NC |
105 | if ($match) { |
106 | my $matches; | |
107 | my $re = qr/$match/; | |
108 | foreach my $file (`git ls-files`) { | |
109 | chomp $file; | |
110 | open my $fh, '<', $file or die "Can't open $file: $!"; | |
111 | while (<$fh>) { | |
112 | if ($_ =~ $re) { | |
113 | ++$matches; | |
114 | $_ .= "\n" unless /\n\z/; | |
115 | print "$file: $_"; | |
116 | } | |
117 | } | |
118 | close $fh or die "Can't close $file: $!"; | |
119 | } | |
120 | report_and_exit(!$matches, 'matches for', 'no matches for', $match); | |
121 | } | |
122 | ||
4b081584 NC |
123 | skip('no Configure - is this the //depot/perlext/Compiler branch?') |
124 | unless -f 'Configure'; | |
125 | ||
dbcdc176 NC |
126 | # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999 |
127 | my $major | |
128 | = extract_from_file('patchlevel.h', | |
129 | qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/, | |
130 | 0); | |
131 | ||
0142f0ce NC |
132 | if ($major < 1) { |
133 | if (extract_from_file('Configure', | |
134 | qr/^ \*=\*\) echo "\$1" >> \$optdef;;$/)) { | |
135 | # This is " Spaces now allowed in -D command line options.", | |
136 | # part of commit ecfc54246c2a6f42 | |
137 | apply_patch(<<'EOPATCH'); | |
138 | diff --git a/Configure b/Configure | |
139 | index 3d3b38d..78ffe16 100755 | |
140 | --- a/Configure | |
141 | +++ b/Configure | |
142 | @@ -652,7 +777,8 @@ while test $# -gt 0; do | |
143 | echo "$me: use '-U symbol=', not '-D symbol='." >&2 | |
144 | echo "$me: ignoring -D $1" >&2 | |
145 | ;; | |
146 | - *=*) echo "$1" >> $optdef;; | |
147 | + *=*) echo "$1" | \ | |
148 | + sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;; | |
149 | *) echo "$1='define'" >> $optdef;; | |
150 | esac | |
151 | shift | |
152 | EOPATCH | |
153 | } | |
154 | if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) { | |
155 | # Configure's original simple "grep" for d_namlen falls foul of the | |
156 | # approach taken by the glibc headers: | |
157 | # #ifdef _DIRENT_HAVE_D_NAMLEN | |
158 | # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen) | |
159 | # | |
160 | # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux. | |
161 | # This is also part of commit ecfc54246c2a6f42 | |
162 | apply_patch(<<'EOPATCH'); | |
163 | diff --git a/Configure b/Configure | |
164 | index 3d3b38d..78ffe16 100755 | |
165 | --- a/Configure | |
166 | +++ b/Configure | |
167 | @@ -3935,7 +4045,8 @@ $rm -f try.c | |
168 | ||
169 | : see if the directory entry stores field length | |
170 | echo " " | |
171 | -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then | |
172 | +$cppstdin $cppflags $cppminus < "$xinc" > try.c | |
173 | +if $contains 'd_namlen' try.c >/dev/null 2>&1; then | |
174 | echo "Good, your directory entry keeps length information in d_namlen." >&4 | |
175 | val="$define" | |
176 | else | |
177 | EOPATCH | |
178 | } | |
179 | } | |
180 | ||
6a8dbfd7 NC |
181 | # There was a bug in makedepend.SH which was fixed in version 96a8704c. |
182 | # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string' | |
183 | # Remove this if you're actually bisecting a problem related to makedepend.SH | |
184 | system 'git show blead:makedepend.SH > makedepend.SH' and die; | |
185 | ||
186 | my @paths = qw(/usr/local/lib64 /lib64 /usr/lib64); | |
187 | ||
188 | # if Encode is not needed for the test, you can speed up the bisect by | |
189 | # excluding it from the runs with -Dnoextensions=Encode | |
190 | # ccache is an easy win. Remove it if it causes problems. | |
191 | my @ARGS = ('-des', '-Dusedevel', '-Doptimize=-g', '-Dcc=ccache gcc', | |
192 | '-Dld=gcc', "-Dlibpth=@paths"); | |
193 | ||
194 | # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it | |
195 | # to true in hints/linux.sh | |
196 | # On dromedary, from that point on, Configure (by default) fails to find any | |
197 | # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain | |
198 | # versioned libraries. Without -lm, the build fails. | |
199 | # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards, | |
200 | # until commit faae14e6e968e1c0 adds it to the hints. | |
201 | # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work, | |
202 | # because it will spot versioned libraries, pass them to the compiler, and then | |
203 | # bail out pretty early on. Configure won't let us override libswanted, but it | |
204 | # will let us override the entire libs list. | |
205 | ||
206 | unless (extract_from_file('Configure', 'ignore_versioned_solibs')) { | |
207 | # Before 1cfa4ec74d4933da, so force the libs list. | |
208 | ||
209 | my @libs; | |
210 | # This is the current libswanted list from Configure, less the libs removed | |
211 | # by current hints/linux.sh | |
212 | foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld | |
213 | ld sun m crypt sec util c cposix posix ucb BSD)) { | |
214 | foreach my $dir (@paths) { | |
215 | next unless -f "$dir/lib$lib.so"; | |
216 | push @libs, "-l$lib"; | |
217 | last; | |
218 | } | |
219 | } | |
220 | push @ARGS, "-Dlibs=@libs"; | |
221 | } | |
222 | ||
4b081584 NC |
223 | # This seems to be necessary to avoid makedepend becoming confused, and hanging |
224 | # on stdin. Seems that the code after make shlist || ...here... is never run. | |
225 | push @ARGS, q{-Dtrnl='\n'} | |
226 | if $major < 4; | |
227 | ||
0142f0ce NC |
228 | push @ARGS, '-Uusenm' |
229 | if $major < 2; | |
230 | ||
67382a3b NC |
231 | my (@missing, @created_dirs); |
232 | ||
f4800c99 | 233 | if ($options{'force-manifest'}) { |
67382a3b NC |
234 | open my $fh, '<', 'MANIFEST' |
235 | or die "Could not open MANIFEST: $!"; | |
236 | while (<$fh>) { | |
237 | next unless /^(\S+)/; | |
238 | push @missing, $1 | |
239 | unless -f $1; | |
240 | } | |
241 | close $fh or die "Can't close MANIFEST: $!"; | |
242 | ||
243 | foreach my $pathname (@missing) { | |
244 | my @parts = split '/', $pathname; | |
245 | my $leaf = pop @parts; | |
246 | my $path = '.'; | |
247 | while (@parts) { | |
248 | $path .= '/' . shift @parts; | |
249 | next if -d $path; | |
250 | mkdir $path, 0700 or die "Can't create $path: $!"; | |
251 | unshift @created_dirs, $path; | |
252 | } | |
253 | open $fh, '>', $pathname or die "Can't open $pathname: $!"; | |
254 | close $fh or die "Can't close $pathname: $!"; | |
255 | chmod 0, $pathname or die "Can't chmod 0 $pathname: $!"; | |
256 | } | |
257 | } | |
258 | ||
6a8dbfd7 NC |
259 | # </dev/null because it seems that some earlier versions of Configure can |
260 | # call commands in a way that now has them reading from stdin (and hanging) | |
261 | my $pid = fork; | |
262 | die "Can't fork: $!" unless defined $pid; | |
263 | if (!$pid) { | |
dbcdc176 NC |
264 | # Before dfe9444ca7881e71, Configure would refuse to run if stdin was not a |
265 | # tty. With that commit, the tty requirement was dropped for -de and -dE | |
8754c3bb | 266 | if($major > 4) { |
67382a3b | 267 | open STDIN, '<', '/dev/null'; |
f4800c99 | 268 | } elsif (!$options{'force-manifest'}) { |
8754c3bb NC |
269 | # If a file in MANIFEST is missing, Configure asks if you want to |
270 | # continue (the default being 'n'). With stdin closed or /dev/null, | |
271 | # it exit immediately and the check for config.sh below will skip. | |
272 | # To avoid a hang, we need to check MANIFEST for ourselves, and skip | |
273 | # if anything is missing. | |
274 | open my $fh, '<', 'MANIFEST'; | |
275 | skip("Could not open MANIFEST: $!") | |
276 | unless $fh; | |
277 | while (<$fh>) { | |
278 | next unless /^(\S+)/; | |
279 | skip("$1 from MANIFEST doesn't exist") | |
280 | unless -f $1; | |
281 | } | |
282 | close $fh or die "Can't close MANIFEST: $!"; | |
283 | } | |
6a8dbfd7 NC |
284 | exec './Configure', @ARGS; |
285 | die "Failed to start Configure: $!"; | |
286 | } | |
287 | waitpid $pid, 0 | |
288 | or die "wait for Configure, pid $pid failed: $!"; | |
289 | ||
290 | # Skip if something went wrong with Configure | |
ab4a15f9 | 291 | skip('no config.sh') unless -f 'config.sh'; |
6a8dbfd7 | 292 | |
67382a3b NC |
293 | # This is probably way too paranoid: |
294 | if (@missing) { | |
295 | my @errors; | |
296 | foreach my $file (@missing) { | |
297 | my (undef, undef, $mode, undef, undef, undef, undef, $size) | |
298 | = stat $file; | |
299 | if (!defined $mode) { | |
300 | push @errors, "Added file $file has been deleted by Configure"; | |
301 | next; | |
302 | } | |
303 | if ($mode != 0) { | |
304 | push @errors, | |
305 | sprintf 'Added file %s had mode changed by Configure to %03o', | |
306 | $file, $mode; | |
307 | } | |
308 | if ($size != 0) { | |
309 | push @errors, | |
310 | "Added file $file had sized changed by Configure to $size"; | |
311 | } | |
312 | unlink $file or die "Can't unlink $file: $!"; | |
313 | } | |
314 | foreach my $dir (@created_dirs) { | |
315 | rmdir $dir or die "Can't rmdir $dir: $!"; | |
316 | } | |
6c0925a0 NC |
317 | skip("@errors") |
318 | if @errors; | |
67382a3b NC |
319 | } |
320 | ||
6a8dbfd7 NC |
321 | # Correct makefile for newer GNU gcc |
322 | # Only really needed if you comment out the use of blead's makedepend.SH | |
323 | { | |
324 | local $^I = ""; | |
325 | local @ARGV = qw(makefile x2p/makefile); | |
326 | while (<>) { | |
327 | print unless /<(?:built-in|command|stdin)/; | |
328 | } | |
329 | } | |
6a8dbfd7 | 330 | |
0142f0ce NC |
331 | if ($major == 2 && extract_from_file('perl.c', qr/^ fclose\(e_fp\);$/)) { |
332 | # need to patch perl.c to avoid calling fclose() twice on e_fp when using -e | |
333 | # This diff is part of commit ab821d7fdc14a438. The second close was | |
334 | # introduced with perl-5.002, commit a5f75d667838e8e7 | |
335 | # Might want a6c477ed8d4864e6 too, for the corresponding change to pp_ctl.c | |
336 | # (likely without this, eval will have "fun") | |
337 | apply_patch(<<'EOPATCH'); | |
338 | diff --git a/perl.c b/perl.c | |
339 | index 03c4d48..3c814a2 100644 | |
340 | --- a/perl.c | |
341 | +++ b/perl.c | |
342 | @@ -252,6 +252,7 @@ setuid perl scripts securely.\n"); | |
343 | #ifndef VMS /* VMS doesn't have environ array */ | |
344 | origenviron = environ; | |
345 | #endif | |
346 | + e_tmpname = Nullch; | |
347 | ||
348 | if (do_undump) { | |
349 | ||
350 | @@ -405,6 +406,7 @@ setuid perl scripts securely.\n"); | |
351 | if (e_fp) { | |
352 | if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp)) | |
353 | croak("Can't write to temp file for -e: %s", Strerror(errno)); | |
354 | + e_fp = Nullfp; | |
355 | argc++,argv--; | |
356 | scriptname = e_tmpname; | |
357 | } | |
358 | @@ -470,10 +472,10 @@ setuid perl scripts securely.\n"); | |
359 | curcop->cop_line = 0; | |
360 | curstash = defstash; | |
361 | preprocess = FALSE; | |
362 | - if (e_fp) { | |
363 | - fclose(e_fp); | |
364 | - e_fp = Nullfp; | |
365 | + if (e_tmpname) { | |
366 | (void)UNLINK(e_tmpname); | |
367 | + Safefree(e_tmpname); | |
368 | + e_tmpname = Nullch; | |
369 | } | |
370 | ||
371 | /* now that script is parsed, we can modify record separator */ | |
372 | @@ -1369,7 +1371,7 @@ SV *sv; | |
373 | scriptname = xfound; | |
374 | } | |
375 | ||
376 | - origfilename = savepv(e_fp ? "-e" : scriptname); | |
377 | + origfilename = savepv(e_tmpname ? "-e" : scriptname); | |
378 | curcop->cop_filegv = gv_fetchfile(origfilename); | |
379 | if (strEQ(origfilename,"-")) | |
380 | scriptname = ""; | |
381 | ||
382 | EOPATCH | |
383 | } | |
384 | ||
9a999a97 NC |
385 | # Parallel build for miniperl is safe |
386 | system "make $j miniperl"; | |
387 | ||
388 | if ($target ne 'miniperl') { | |
389 | # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that. | |
390 | $j = '' unless $major > 10; | |
391 | ||
392 | if ($target eq 'test_prep') { | |
393 | if ($major < 8) { | |
394 | # test-prep was added in 5.004_01, 3e3baf6d63945cb6. | |
395 | # renamed to test_prep in 2001 in 5fe84fd29acaf55c. | |
396 | # earlier than that, just make test. It will be fast enough. | |
397 | $target = extract_from_file('Makefile.SH', qr/^(test[-_]prep):/, | |
398 | 'test'); | |
399 | } | |
6a8dbfd7 | 400 | } |
6a8dbfd7 | 401 | |
9a999a97 NC |
402 | system "make $j $target"; |
403 | } | |
6a8dbfd7 | 404 | |
67382a3b NC |
405 | my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected; |
406 | ||
f4800c99 | 407 | if ($options{'test-build'}) { |
67382a3b NC |
408 | report_and_exit($missing_target, 'could build', 'could not build', $target); |
409 | } elsif ($missing_target) { | |
410 | skip("could not build $target"); | |
411 | } | |
6a8dbfd7 NC |
412 | |
413 | # This is what we came here to run: | |
414 | my $ret = system @ARGV; | |
415 | ||
f1050811 | 416 | report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV"); |
9a999a97 NC |
417 | |
418 | # Local variables: | |
419 | # cperl-indent-level: 4 | |
420 | # indent-tabs-mode: nil | |
421 | # End: | |
422 | # | |
423 | # ex: set ts=8 sts=4 sw=4 et: |