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