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