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