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