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