Commit | Line | Data |
---|---|---|
6a8dbfd7 NC |
1 | #!/usr/bin/perl -w |
2 | use strict; | |
3 | ||
390a69a9 | 4 | use Getopt::Long qw(:config bundling no_auto_abbrev); |
77ae6092 | 5 | use Pod::Usage; |
6a8dbfd7 | 6 | |
0afef97d | 7 | my @targets = qw(config.sh config.h miniperl lib/Config.pm perl test_prep); |
6a8dbfd7 | 8 | |
f4800c99 NC |
9 | my %options = |
10 | ( | |
f4800c99 NC |
11 | jobs => 9, |
12 | 'expect-pass' => 1, | |
13 | clean => 1, # mostly for debugging this | |
14 | ); | |
6a8dbfd7 | 15 | |
390a69a9 NC |
16 | my @paths = qw(/usr/local/lib64 /lib64 /usr/lib64); |
17 | ||
18 | my %defines = | |
19 | ( | |
20 | usedevel => '', | |
21 | optimize => '-g', | |
22 | cc => 'ccache gcc', | |
23 | ld => 'gcc', | |
24 | 'libpth' => \@paths, | |
25 | ); | |
26 | ||
f4800c99 NC |
27 | unless(GetOptions(\%options, |
28 | 'target=s', 'jobs|j=i', 'expect-pass=i', | |
29 | 'expect-fail' => sub { $options{'expect-pass'} = 0; }, | |
30 | 'clean!', 'one-liner|e=s', 'match=s', 'force-manifest', | |
77ae6092 | 31 | 'test-build', 'check-args', 'A=s@', 'usage|help|?', |
390a69a9 NC |
32 | 'D=s@' => sub { |
33 | my (undef, $val) = @_; | |
34 | if ($val =~ /\A([^=]+)=(.*)/s) { | |
35 | $defines{$1} = length $2 ? $2 : "\0"; | |
36 | } else { | |
37 | $defines{$val} = ''; | |
38 | } | |
39 | }, | |
40 | 'U=s@' => sub { | |
41 | $defines{$_[1]} = undef; | |
42 | }, | |
6a8dbfd7 | 43 | )) { |
77ae6092 | 44 | pod2usage(exitval => 255, verbose => 1); |
6a8dbfd7 NC |
45 | } |
46 | ||
f4800c99 | 47 | my ($target, $j, $match) = @options{qw(target jobs match)}; |
e295b7be | 48 | |
77ae6092 NC |
49 | pod2usage(exitval => 255, verbose => 1) if $options{usage}; |
50 | pod2usage(exitval => 255, verbose => 1) | |
51 | unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'}; | |
6a8dbfd7 | 52 | |
f4800c99 | 53 | exit 0 if $options{'check-args'}; |
6a8dbfd7 | 54 | |
77ae6092 NC |
55 | =head1 NAME |
56 | ||
57 | bisect.pl - use git bisect to pinpoint changes | |
58 | ||
59 | =head1 SYNOPSIS | |
60 | ||
61 | # When did this become an error? | |
62 | .../Porting/bisect.pl -e 'my $a := 2;' | |
63 | # When did this become stop being an error? | |
64 | .../Porting/bisect.pl --expect-fail -e '1 // 2' | |
65 | # When did this stop matching? | |
66 | .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b' | |
67 | # When did this start matching? | |
68 | .../Porting/bisect.pl --expect-fail --match '\buseithreads\b' | |
69 | # When did this test program stop working? | |
70 | .../Porting/bisect.pl --target=perl -- ./perl -Ilib test_prog.pl | |
71 | # When did this first become valid syntax? | |
72 | .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \ | |
73 | --expect-fail -e 'my $a := 2;' | |
74 | # What was the last revision to build with these options? | |
75 | .../Porting/bisect.pl --test-build -Dd_dosuid | |
76 | ||
77 | =head1 DESCRIPTION | |
78 | ||
79 | Together C<bisect.pl> and C<bisect-runner.pl> attempt to automate the use | |
80 | of C<git bisect> as much as possible. With one command (and no other files) | |
81 | it's easy to find out | |
82 | ||
83 | =over 4 | |
84 | ||
85 | =item * | |
86 | ||
87 | Which commit caused this example code to break? | |
88 | ||
89 | =item * | |
90 | ||
91 | Which commit caused this example code to start working? | |
92 | ||
93 | =item * | |
94 | ||
95 | Which commit added the first to match this regex? | |
96 | ||
97 | =item * | |
98 | ||
99 | Which commit removed the last to match this regex? | |
100 | ||
101 | =back | |
102 | ||
103 | usually without needing to know which versions of perl to use as start and | |
104 | end revisions. | |
105 | ||
106 | By default C<bisect.pl> will process all options, then use the rest of the | |
107 | command line as arguments to list C<system> to run a test case. By default, | |
108 | the test case should pass (exit with 0) on earlier perls, and fail (exit | |
109 | non-zero) on I<blead>. C<bisect.pl> will use C<bisect-runner.pl> to find the | |
110 | earliest stable perl version on which the test case passes, check that it | |
111 | fails on blead, and then use C<bisect-runner.pl> with C<git bisect run> to | |
112 | find the commit which caused the failure. | |
113 | ||
114 | Because the test case is the complete argument to C<system>, it is easy to | |
115 | run something other than the F<perl> built, if necessary. If you need to run | |
116 | the perl built, you'll probably need to invoke it as C<./perl -Ilib ...> | |
117 | ||
118 | =head1 OPTIONS | |
119 | ||
120 | =over 4 | |
121 | ||
122 | =item * | |
123 | ||
124 | --start I<commit-ish> | |
125 | ||
126 | Earliest revision to test, as a I<commit-ish> (a tag, commit or anything | |
127 | else C<git> understands as a revision. If not specified, C<bisect.pl> will | |
128 | search stable perl releases from 5.002 to 5.14.0 until it finds one where | |
129 | the test case passes. | |
130 | ||
131 | =item * | |
132 | ||
133 | --end I<commit-ish> | |
134 | ||
135 | Most recent revision to test, as a I<commit-ish>. If not specified, defaults | |
136 | to I<blead> | |
137 | ||
138 | =item * | |
139 | ||
140 | --target I<target> | |
141 | ||
142 | F<Makefile> target (or equivalent) needed, to run the test case. If specified, | |
143 | this should be one of | |
144 | ||
145 | =over 4 | |
146 | ||
147 | =item * | |
148 | ||
149 | I<config.sh> | |
150 | ||
151 | Just run C<Configure> | |
152 | ||
153 | =item * | |
154 | ||
155 | I<config.h> | |
156 | ||
157 | Run the various F<*.SH> files to generate F<Makefile>, F<config.h>, I<etc>. | |
158 | ||
159 | =item * | |
160 | ||
161 | I<miniperl> | |
162 | ||
163 | Build F<miniperl>. | |
164 | ||
165 | =item * | |
166 | ||
167 | I<lib/Config.pm> | |
168 | ||
169 | Use F<miniperl> to build F<lib/Config.pm> | |
170 | ||
171 | =item * | |
172 | ||
173 | I<perl> | |
174 | ||
175 | Build F<perl>. This also builds pure-Perl modules in F<cpan>, F<dist> and | |
176 | F<ext>. | |
177 | ||
178 | =item * | |
179 | ||
180 | I<test_prep> | |
181 | ||
182 | Build everything needed to run the tests. This is the default if we're | |
183 | running test code, but is time consuming, as it means building all | |
184 | C<XS> modules. For older F<Makefile>s, the previous name of C<test-prep> | |
185 | is automatically substituted. For very old F<Makefile>s, C<make test> is | |
186 | run, as there is no target provided to just get things ready, and for 5.004 | |
187 | and earlier the tests run very quickly. | |
188 | ||
189 | =back | |
190 | ||
191 | =item * | |
192 | ||
193 | --one-liner 'code to run' | |
194 | ||
195 | =item * | |
196 | ||
197 | -e 'code to run' | |
198 | ||
199 | Example code to run, just like you'd use with C<perl -e>. | |
200 | ||
201 | This prepends C<./perl -Ilib -e 'code to run'> to the test case given, | |
202 | or C<./miniperl> if I<target> is C<miniperl> | |
203 | ||
204 | (Usually you'll use C<-e> instead of providing a test case in the | |
205 | non-option arguments to C<bisect.pl>) | |
206 | ||
207 | C<-E> intentionally isn't supported, as it's an error in 5.8.0 and earlier, | |
208 | which interferes with detecting errors in the example code itself. | |
209 | ||
210 | =item * | |
211 | ||
212 | --expect-fail | |
213 | ||
214 | The test case should fail for the I<start> revision, and pass for the I<end> | |
215 | revision. The bisect run will find the first commit where it passes. | |
216 | ||
217 | =item * | |
218 | ||
219 | -Dusethreads | |
220 | ||
221 | =item * | |
222 | ||
223 | -Uusedevel | |
224 | ||
225 | =item * | |
226 | ||
227 | -Accflags=-DNO_MATHOMS | |
228 | ||
229 | Arguments to pass to F<Configure>. Repeated C<-A> arguments are passed | |
230 | through as is. C<-D> and C<-U> are processed in order, and override | |
231 | previous settings for the same parameter. | |
232 | ||
233 | =item * | |
234 | ||
235 | --jobs | |
236 | ||
237 | =item * | |
238 | ||
239 | -j | |
240 | ||
241 | Number of C<make> jobs to run in parallel. Currently defaults to 9. | |
242 | ||
243 | =item * | |
244 | ||
245 | --match | |
246 | ||
247 | Instead of running a test program to determine I<pass> or I<fail>, pass | |
248 | if the given regex matches, and hence search for the commit that removes | |
249 | the last matching file. | |
250 | ||
251 | If no I<target> is specified, the match is against all files in the | |
252 | repository (which is fast). If a I<target> is specified, that target is | |
253 | built, and the match is against only the built files. C<--expect-fail> can | |
254 | be used with C<--match> to search for a commit that adds files that match. | |
255 | ||
256 | =item * | |
257 | ||
258 | --test-build | |
259 | ||
260 | Test that the build completes, without running any test case. | |
261 | ||
262 | By default, if the build for the desired I<target> fails to complete, | |
263 | F<bisect-runner.pl> reports a I<skip> back to C<git bisect>, the assumption | |
264 | being that one wants to find a commit which changed state "builds && passes" | |
265 | to "builds && fails". If instead one is interested in which commit broke the | |
266 | build (possibly for particular F<Configure> options), use I<--test-build> | |
267 | to treat a build failure as a failure, not a "skip". | |
268 | ||
269 | =item * | |
270 | ||
271 | By default, a build will "skip" if any files listed in F<MANIFEST> are not | |
272 | present. Usually this is useful, as it avoids false-failures. However, there | |
273 | are some long ranges of commits where listed files are missing, which can | |
274 | cause a bisect to abort because all that remain are skipped revisions. | |
275 | ||
276 | In these cases, particularly if the test case uses F<miniperl> and no modules, | |
277 | it may be more useful to force the build to continue, even if files | |
278 | F<MANIFEST> are missing. | |
279 | ||
280 | =item * | |
281 | ||
282 | --expect-pass [0|1] | |
283 | ||
284 | C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1> is the default. | |
285 | ||
286 | =item * | |
287 | ||
288 | --no-clean | |
289 | ||
290 | Tell F<bisect-runner.pl> not to clean up after the build. This allows one | |
291 | to use F<bisect-runner.pl> to build the current particular perl revision for | |
292 | interactive testing, or for debugging F<bisect-runner.pl>. | |
293 | ||
294 | Passing this to F<bisect.pl> will likely cause the bisect to fail badly. | |
295 | ||
296 | =item * | |
297 | ||
298 | --check-args | |
299 | ||
300 | Validate the options and arguments, and exit silently if they are valid. | |
301 | ||
302 | =item * | |
303 | ||
304 | --usage | |
305 | ||
306 | =item * | |
307 | ||
308 | --help | |
309 | ||
310 | =item * | |
311 | ||
312 | -? | |
313 | ||
314 | Display the usage information and exit. | |
315 | ||
316 | =back | |
317 | ||
318 | =cut | |
319 | ||
0afef97d | 320 | die "$0: Can't build $target" if defined $target && !grep {@targets} $target; |
6a8dbfd7 NC |
321 | |
322 | $j = "-j$j" if $j =~ /\A\d+\z/; | |
323 | ||
0142f0ce NC |
324 | # Sadly, however hard we try, I don't think that it will be possible to build |
325 | # modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29, | |
326 | # which updated to MakeMaker 3.7, which changed from using a hard coded ld | |
327 | # in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc. | |
328 | ||
6a8dbfd7 NC |
329 | sub extract_from_file { |
330 | my ($file, $rx, $default) = @_; | |
331 | open my $fh, '<', $file or die "Can't open $file: $!"; | |
332 | while (<$fh>) { | |
333 | my @got = $_ =~ $rx; | |
334 | return wantarray ? @got : $got[0] | |
335 | if @got; | |
336 | } | |
337 | return $default if defined $default; | |
338 | return; | |
339 | } | |
340 | ||
ab4a15f9 | 341 | sub clean { |
f4800c99 | 342 | if ($options{clean}) { |
ab4a15f9 NC |
343 | # Needed, because files that are build products in this checked out |
344 | # version might be in git in the next desired version. | |
345 | system 'git clean -dxf'; | |
346 | # Needed, because at some revisions the build alters checked out files. | |
347 | # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH | |
348 | system 'git reset --hard HEAD'; | |
349 | } | |
350 | } | |
351 | ||
352 | sub skip { | |
353 | my $reason = shift; | |
354 | clean(); | |
355 | warn "skipping - $reason"; | |
356 | exit 125; | |
357 | } | |
358 | ||
f1050811 NC |
359 | sub report_and_exit { |
360 | my ($ret, $pass, $fail, $desc) = @_; | |
361 | ||
362 | clean(); | |
363 | ||
f4800c99 | 364 | my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad'; |
f1050811 NC |
365 | if ($ret) { |
366 | print "$got - $fail $desc\n"; | |
367 | } else { | |
368 | print "$got - $pass $desc\n"; | |
369 | } | |
370 | ||
371 | exit($got eq 'bad'); | |
372 | } | |
373 | ||
0afef97d NC |
374 | sub match_and_exit { |
375 | my $target = shift; | |
376 | my $matches = 0; | |
377 | my $re = qr/$match/; | |
378 | my @files; | |
379 | ||
380 | { | |
381 | local $/ = "\0"; | |
382 | @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`; | |
383 | chomp @files; | |
384 | } | |
385 | ||
386 | foreach my $file (@files) { | |
387 | open my $fh, '<', $file or die "Can't open $file: $!"; | |
388 | while (<$fh>) { | |
389 | if ($_ =~ $re) { | |
390 | ++$matches; | |
391 | if (tr/\t\r\n -~\200-\377//c) { | |
392 | print "Binary file $file matches\n"; | |
393 | } else { | |
394 | $_ .= "\n" unless /\n\z/; | |
395 | print "$file: $_"; | |
396 | } | |
397 | } | |
398 | } | |
399 | close $fh or die "Can't close $file: $!"; | |
400 | } | |
401 | report_and_exit(!$matches, | |
402 | $matches == 1 ? '1 match for' : "$matches matches for", | |
403 | 'no matches for', $match); | |
404 | } | |
405 | ||
0142f0ce NC |
406 | sub apply_patch { |
407 | my $patch = shift; | |
408 | ||
f1193e4b | 409 | my ($file) = $patch =~ qr!^diff.*a/(\S+) b/\1!; |
0142f0ce NC |
410 | open my $fh, '|-', 'patch' or die "Can't run patch: $!"; |
411 | print $fh $patch; | |
f1193e4b | 412 | close $fh or die "Can't patch $file: $?, $!"; |
0142f0ce NC |
413 | } |
414 | ||
6a8dbfd7 NC |
415 | # Not going to assume that system perl is yet new enough to have autodie |
416 | system 'git clean -dxf' and die; | |
417 | ||
0afef97d NC |
418 | if (!defined $target) { |
419 | match_and_exit() if $match; | |
420 | $target = 'test_prep'; | |
bc96a05a NC |
421 | } |
422 | ||
4b081584 NC |
423 | skip('no Configure - is this the //depot/perlext/Compiler branch?') |
424 | unless -f 'Configure'; | |
425 | ||
dbcdc176 NC |
426 | # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999 |
427 | my $major | |
428 | = extract_from_file('patchlevel.h', | |
429 | qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/, | |
430 | 0); | |
431 | ||
0142f0ce NC |
432 | if ($major < 1) { |
433 | if (extract_from_file('Configure', | |
434 | qr/^ \*=\*\) echo "\$1" >> \$optdef;;$/)) { | |
435 | # This is " Spaces now allowed in -D command line options.", | |
436 | # part of commit ecfc54246c2a6f42 | |
437 | apply_patch(<<'EOPATCH'); | |
438 | diff --git a/Configure b/Configure | |
439 | index 3d3b38d..78ffe16 100755 | |
440 | --- a/Configure | |
441 | +++ b/Configure | |
442 | @@ -652,7 +777,8 @@ while test $# -gt 0; do | |
443 | echo "$me: use '-U symbol=', not '-D symbol='." >&2 | |
444 | echo "$me: ignoring -D $1" >&2 | |
445 | ;; | |
446 | - *=*) echo "$1" >> $optdef;; | |
447 | + *=*) echo "$1" | \ | |
448 | + sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;; | |
449 | *) echo "$1='define'" >> $optdef;; | |
450 | esac | |
451 | shift | |
452 | EOPATCH | |
453 | } | |
454 | if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) { | |
455 | # Configure's original simple "grep" for d_namlen falls foul of the | |
456 | # approach taken by the glibc headers: | |
457 | # #ifdef _DIRENT_HAVE_D_NAMLEN | |
458 | # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen) | |
459 | # | |
460 | # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux. | |
461 | # This is also part of commit ecfc54246c2a6f42 | |
462 | apply_patch(<<'EOPATCH'); | |
463 | diff --git a/Configure b/Configure | |
464 | index 3d3b38d..78ffe16 100755 | |
465 | --- a/Configure | |
466 | +++ b/Configure | |
467 | @@ -3935,7 +4045,8 @@ $rm -f try.c | |
468 | ||
469 | : see if the directory entry stores field length | |
470 | echo " " | |
471 | -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then | |
472 | +$cppstdin $cppflags $cppminus < "$xinc" > try.c | |
473 | +if $contains 'd_namlen' try.c >/dev/null 2>&1; then | |
474 | echo "Good, your directory entry keeps length information in d_namlen." >&4 | |
475 | val="$define" | |
476 | else | |
477 | EOPATCH | |
478 | } | |
479 | } | |
480 | ||
6a8dbfd7 NC |
481 | # There was a bug in makedepend.SH which was fixed in version 96a8704c. |
482 | # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string' | |
483 | # Remove this if you're actually bisecting a problem related to makedepend.SH | |
484 | system 'git show blead:makedepend.SH > makedepend.SH' and die; | |
485 | ||
6a8dbfd7 NC |
486 | # if Encode is not needed for the test, you can speed up the bisect by |
487 | # excluding it from the runs with -Dnoextensions=Encode | |
488 | # ccache is an easy win. Remove it if it causes problems. | |
6a8dbfd7 NC |
489 | # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it |
490 | # to true in hints/linux.sh | |
491 | # On dromedary, from that point on, Configure (by default) fails to find any | |
492 | # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain | |
493 | # versioned libraries. Without -lm, the build fails. | |
494 | # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards, | |
495 | # until commit faae14e6e968e1c0 adds it to the hints. | |
496 | # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work, | |
497 | # because it will spot versioned libraries, pass them to the compiler, and then | |
498 | # bail out pretty early on. Configure won't let us override libswanted, but it | |
499 | # will let us override the entire libs list. | |
500 | ||
501 | unless (extract_from_file('Configure', 'ignore_versioned_solibs')) { | |
502 | # Before 1cfa4ec74d4933da, so force the libs list. | |
503 | ||
504 | my @libs; | |
505 | # This is the current libswanted list from Configure, less the libs removed | |
506 | # by current hints/linux.sh | |
507 | foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld | |
508 | ld sun m crypt sec util c cposix posix ucb BSD)) { | |
509 | foreach my $dir (@paths) { | |
510 | next unless -f "$dir/lib$lib.so"; | |
511 | push @libs, "-l$lib"; | |
512 | last; | |
513 | } | |
514 | } | |
390a69a9 | 515 | $defines{libs} = \@libs unless exists $defines{libs}; |
6a8dbfd7 NC |
516 | } |
517 | ||
4b081584 NC |
518 | # This seems to be necessary to avoid makedepend becoming confused, and hanging |
519 | # on stdin. Seems that the code after make shlist || ...here... is never run. | |
390a69a9 NC |
520 | $defines{trnl} = q{'\n'} |
521 | if $major < 4 && !exists $defines{trnl}; | |
4b081584 | 522 | |
390a69a9 NC |
523 | $defines{usenm} = undef |
524 | if $major < 2 && !exists $defines{usenm}; | |
0142f0ce | 525 | |
67382a3b NC |
526 | my (@missing, @created_dirs); |
527 | ||
f4800c99 | 528 | if ($options{'force-manifest'}) { |
67382a3b NC |
529 | open my $fh, '<', 'MANIFEST' |
530 | or die "Could not open MANIFEST: $!"; | |
531 | while (<$fh>) { | |
532 | next unless /^(\S+)/; | |
533 | push @missing, $1 | |
534 | unless -f $1; | |
535 | } | |
536 | close $fh or die "Can't close MANIFEST: $!"; | |
537 | ||
538 | foreach my $pathname (@missing) { | |
539 | my @parts = split '/', $pathname; | |
540 | my $leaf = pop @parts; | |
541 | my $path = '.'; | |
542 | while (@parts) { | |
543 | $path .= '/' . shift @parts; | |
544 | next if -d $path; | |
545 | mkdir $path, 0700 or die "Can't create $path: $!"; | |
546 | unshift @created_dirs, $path; | |
547 | } | |
548 | open $fh, '>', $pathname or die "Can't open $pathname: $!"; | |
549 | close $fh or die "Can't close $pathname: $!"; | |
550 | chmod 0, $pathname or die "Can't chmod 0 $pathname: $!"; | |
551 | } | |
552 | } | |
553 | ||
dd4e46d7 | 554 | my @ARGS = $target eq 'config.sh' ? '-dEs' : '-des'; |
390a69a9 NC |
555 | foreach my $key (sort keys %defines) { |
556 | my $val = $defines{$key}; | |
557 | if (ref $val) { | |
558 | push @ARGS, "-D$key=@$val"; | |
559 | } elsif (!defined $val) { | |
560 | push @ARGS, "-U$key"; | |
561 | } elsif (!length $val) { | |
562 | push @ARGS, "-D$key"; | |
563 | } else { | |
564 | $val = "" if $val eq "\0"; | |
565 | push @ARGS, "-D$key=$val"; | |
566 | } | |
567 | } | |
568 | push @ARGS, map {"-A$_"} @{$options{A}}; | |
569 | ||
6a8dbfd7 NC |
570 | # </dev/null because it seems that some earlier versions of Configure can |
571 | # call commands in a way that now has them reading from stdin (and hanging) | |
572 | my $pid = fork; | |
573 | die "Can't fork: $!" unless defined $pid; | |
574 | if (!$pid) { | |
dbcdc176 NC |
575 | # Before dfe9444ca7881e71, Configure would refuse to run if stdin was not a |
576 | # tty. With that commit, the tty requirement was dropped for -de and -dE | |
8754c3bb | 577 | if($major > 4) { |
67382a3b | 578 | open STDIN, '<', '/dev/null'; |
f4800c99 | 579 | } elsif (!$options{'force-manifest'}) { |
8754c3bb NC |
580 | # If a file in MANIFEST is missing, Configure asks if you want to |
581 | # continue (the default being 'n'). With stdin closed or /dev/null, | |
582 | # it exit immediately and the check for config.sh below will skip. | |
583 | # To avoid a hang, we need to check MANIFEST for ourselves, and skip | |
584 | # if anything is missing. | |
585 | open my $fh, '<', 'MANIFEST'; | |
586 | skip("Could not open MANIFEST: $!") | |
587 | unless $fh; | |
588 | while (<$fh>) { | |
589 | next unless /^(\S+)/; | |
590 | skip("$1 from MANIFEST doesn't exist") | |
591 | unless -f $1; | |
592 | } | |
593 | close $fh or die "Can't close MANIFEST: $!"; | |
594 | } | |
6a8dbfd7 NC |
595 | exec './Configure', @ARGS; |
596 | die "Failed to start Configure: $!"; | |
597 | } | |
598 | waitpid $pid, 0 | |
599 | or die "wait for Configure, pid $pid failed: $!"; | |
600 | ||
0afef97d NC |
601 | if ($target =~ /config\.s?h/) { |
602 | match_and_exit($target) if $match && -f $target; | |
dd4e46d7 NC |
603 | report_and_exit(!-f $target, 'could build', 'could not build', $target); |
604 | } elsif (!-f 'config.sh') { | |
605 | # Skip if something went wrong with Configure | |
606 | ||
607 | skip('could not build config.sh'); | |
608 | } | |
6a8dbfd7 | 609 | |
67382a3b NC |
610 | # This is probably way too paranoid: |
611 | if (@missing) { | |
612 | my @errors; | |
eb4906f4 | 613 | require Fcntl; |
67382a3b NC |
614 | foreach my $file (@missing) { |
615 | my (undef, undef, $mode, undef, undef, undef, undef, $size) | |
616 | = stat $file; | |
617 | if (!defined $mode) { | |
618 | push @errors, "Added file $file has been deleted by Configure"; | |
619 | next; | |
620 | } | |
eb4906f4 | 621 | if (Fcntl::S_IMODE($mode) != 0) { |
67382a3b NC |
622 | push @errors, |
623 | sprintf 'Added file %s had mode changed by Configure to %03o', | |
624 | $file, $mode; | |
625 | } | |
626 | if ($size != 0) { | |
627 | push @errors, | |
628 | "Added file $file had sized changed by Configure to $size"; | |
629 | } | |
630 | unlink $file or die "Can't unlink $file: $!"; | |
631 | } | |
632 | foreach my $dir (@created_dirs) { | |
633 | rmdir $dir or die "Can't rmdir $dir: $!"; | |
634 | } | |
6c0925a0 NC |
635 | skip("@errors") |
636 | if @errors; | |
67382a3b NC |
637 | } |
638 | ||
6a8dbfd7 NC |
639 | # Correct makefile for newer GNU gcc |
640 | # Only really needed if you comment out the use of blead's makedepend.SH | |
641 | { | |
642 | local $^I = ""; | |
643 | local @ARGV = qw(makefile x2p/makefile); | |
644 | while (<>) { | |
645 | print unless /<(?:built-in|command|stdin)/; | |
646 | } | |
647 | } | |
6a8dbfd7 | 648 | |
0142f0ce NC |
649 | if ($major == 2 && extract_from_file('perl.c', qr/^ fclose\(e_fp\);$/)) { |
650 | # need to patch perl.c to avoid calling fclose() twice on e_fp when using -e | |
651 | # This diff is part of commit ab821d7fdc14a438. The second close was | |
652 | # introduced with perl-5.002, commit a5f75d667838e8e7 | |
653 | # Might want a6c477ed8d4864e6 too, for the corresponding change to pp_ctl.c | |
654 | # (likely without this, eval will have "fun") | |
655 | apply_patch(<<'EOPATCH'); | |
656 | diff --git a/perl.c b/perl.c | |
657 | index 03c4d48..3c814a2 100644 | |
658 | --- a/perl.c | |
659 | +++ b/perl.c | |
660 | @@ -252,6 +252,7 @@ setuid perl scripts securely.\n"); | |
661 | #ifndef VMS /* VMS doesn't have environ array */ | |
662 | origenviron = environ; | |
663 | #endif | |
664 | + e_tmpname = Nullch; | |
665 | ||
666 | if (do_undump) { | |
667 | ||
668 | @@ -405,6 +406,7 @@ setuid perl scripts securely.\n"); | |
669 | if (e_fp) { | |
670 | if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp)) | |
671 | croak("Can't write to temp file for -e: %s", Strerror(errno)); | |
672 | + e_fp = Nullfp; | |
673 | argc++,argv--; | |
674 | scriptname = e_tmpname; | |
675 | } | |
676 | @@ -470,10 +472,10 @@ setuid perl scripts securely.\n"); | |
677 | curcop->cop_line = 0; | |
678 | curstash = defstash; | |
679 | preprocess = FALSE; | |
680 | - if (e_fp) { | |
681 | - fclose(e_fp); | |
682 | - e_fp = Nullfp; | |
683 | + if (e_tmpname) { | |
684 | (void)UNLINK(e_tmpname); | |
685 | + Safefree(e_tmpname); | |
686 | + e_tmpname = Nullch; | |
687 | } | |
688 | ||
689 | /* now that script is parsed, we can modify record separator */ | |
690 | @@ -1369,7 +1371,7 @@ SV *sv; | |
691 | scriptname = xfound; | |
692 | } | |
693 | ||
694 | - origfilename = savepv(e_fp ? "-e" : scriptname); | |
695 | + origfilename = savepv(e_tmpname ? "-e" : scriptname); | |
696 | curcop->cop_filegv = gv_fetchfile(origfilename); | |
697 | if (strEQ(origfilename,"-")) | |
698 | scriptname = ""; | |
699 | ||
700 | EOPATCH | |
701 | } | |
702 | ||
9a999a97 NC |
703 | # Parallel build for miniperl is safe |
704 | system "make $j miniperl"; | |
705 | ||
706 | if ($target ne 'miniperl') { | |
707 | # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that. | |
372ba1f9 | 708 | $j = '' if $major < 10; |
9a999a97 NC |
709 | |
710 | if ($target eq 'test_prep') { | |
711 | if ($major < 8) { | |
712 | # test-prep was added in 5.004_01, 3e3baf6d63945cb6. | |
713 | # renamed to test_prep in 2001 in 5fe84fd29acaf55c. | |
714 | # earlier than that, just make test. It will be fast enough. | |
715 | $target = extract_from_file('Makefile.SH', qr/^(test[-_]prep):/, | |
716 | 'test'); | |
717 | } | |
6a8dbfd7 | 718 | } |
6a8dbfd7 | 719 | |
9a999a97 NC |
720 | system "make $j $target"; |
721 | } | |
6a8dbfd7 | 722 | |
372ba1f9 | 723 | my $expected = $target =~ /^test/ ? 'perl' : $target; |
67382a3b NC |
724 | my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected; |
725 | ||
f4800c99 | 726 | if ($options{'test-build'}) { |
67382a3b NC |
727 | report_and_exit($missing_target, 'could build', 'could not build', $target); |
728 | } elsif ($missing_target) { | |
729 | skip("could not build $target"); | |
730 | } | |
6a8dbfd7 | 731 | |
0afef97d NC |
732 | match_and_exit($target) if $match; |
733 | ||
734 | if (defined $options{'one-liner'}) { | |
372ba1f9 | 735 | my $exe = $target ne 'miniperl' ? 'perl' : 'miniperl'; |
0afef97d NC |
736 | unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'}; |
737 | } | |
738 | ||
6a8dbfd7 NC |
739 | # This is what we came here to run: |
740 | my $ret = system @ARGV; | |
741 | ||
f1050811 | 742 | report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV"); |
9a999a97 NC |
743 | |
744 | # Local variables: | |
745 | # cperl-indent-level: 4 | |
746 | # indent-tabs-mode: nil | |
747 | # End: | |
748 | # | |
749 | # ex: set ts=8 sts=4 sw=4 et: |