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