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 edit_file {
 393     my ($file, $munger) = @_;
 394     local $/;
 395     open my $fh, '<', $file or die "Can't open $file: $!";
 396     my $orig = <$fh>;
 397     die "Can't read $file: $!" unless defined $orig && close $fh;
 398     my $new = $munger->($orig);
 399     return if $new eq $orig;
 400     open $fh, '>', $file or die "Can't open $file: $!";
 401     print $fh $new or die "Can't print to $file: $!";
 402     close $fh or die "Can't close $file: $!";
 403 }
 404
 405 sub apply_patch {
 406     my $patch = shift;
 407
 408     my ($file) = $patch =~ qr!^diff.*a/(\S+) b/\1!;
 409     open my $fh, '|-', 'patch', '-p1' or die "Can't run patch: $!";
 410     print $fh $patch;
 411     return if close $fh;
 412     print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n";
 413     die "Can't patch $file: $?, $!";
 414 }
 415
 416 sub clean {
 417     if ($options{clean}) {
 418         # Needed, because files that are build products in this checked out
 419         # version might be in git in the next desired version.
 420         system 'git clean -dxf </dev/null';
 421         # Needed, because at some revisions the build alters checked out files.
 422         # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
 423         system 'git reset --hard HEAD </dev/null';
 424     }
 425 }
 426
 427 sub skip {
 428     my $reason = shift;
 429     clean();
 430     warn "skipping - $reason";
 431     exit 125;
 432 }
 433
 434 sub report_and_exit {
 435     my ($ret, $pass, $fail, $desc) = @_;
 436
 437     clean();
 438
 439     my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad';
 440     if ($ret) {
 441         print "$got - $fail $desc\n";
 442     } else {
 443         print "$got - $pass $desc\n";
 444     }
 445
 446     exit($got eq 'bad');
 447 }
 448
 449 sub match_and_exit {
 450     my $target = shift;
 451     my $matches = 0;
 452     my $re = qr/$match/;
 453     my @files;
 454
 455     {
 456         local $/ = "\0";
 457         @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`;
 458         chomp @files;
 459     }
 460
 461     foreach my $file (@files) {
 462         open my $fh, '<', $file or die "Can't open $file: $!";
 463         while (<$fh>) {
 464             if ($_ =~ $re) {
 465                 ++$matches;
 466                 if (tr/\t\r\n -~\200-\377//c) {
 467                     print "Binary file $file matches\n";
 468                 } else {
 469                     $_ .= "\n" unless /\n\z/;
 470                     print "$file: $_";
 471                 }
 472             }
 473         }
 474         close $fh or die "Can't close $file: $!";
 475     }
 476     report_and_exit(!$matches,
 477                     $matches == 1 ? '1 match for' : "$matches matches for",
 478                     'no matches for', $match);
 479 }
 480
 481 # Not going to assume that system perl is yet new enough to have autodie
 482 system 'git clean -dxf </dev/null' and die;
 483
 484 if (!defined $target) {
 485     match_and_exit() if $match;
 486     $target = 'test_prep';
 487 }
 488
 489 skip('no Configure - is this the //depot/perlext/Compiler branch?')
 490     unless -f 'Configure';
 491
 492 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
 493 my $major
 494     = extract_from_file('patchlevel.h',
 495                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
 496                         0);
 497
 498 if ($major < 1) {
 499     if (extract_from_file('Configure',
 500                           qr/^          \*=\*\) echo "\$1" >> \$optdef;;$/)) {
 501         # This is "        Spaces now allowed in -D command line options.",
 502         # part of commit ecfc54246c2a6f42
 503         apply_patch(<<'EOPATCH');
 504 diff --git a/Configure b/Configure
 505 index 3d3b38d..78ffe16 100755
 506 --- a/Configure
 507 +++ b/Configure
 508 @@ -652,7 +777,8 @@ while test $# -gt 0; do
 509                         echo "$me: use '-U symbol=', not '-D symbol='." >&2
 510                         echo "$me: ignoring -D $1" >&2
 511                         ;;
 512 -               *=*) echo "$1" >> $optdef;;
 513 +               *=*) echo "$1" | \
 514 +                               sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;;
 515                 *) echo "$1='define'" >> $optdef;;
 516                 esac
 517                 shift
 518 EOPATCH
 519     }
 520     if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) {
 521         # Configure's original simple "grep" for d_namlen falls foul of the
 522         # approach taken by the glibc headers:
 523         # #ifdef _DIRENT_HAVE_D_NAMLEN
 524         # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen)
 525         #
 526         # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux.
 527         # This is also part of commit ecfc54246c2a6f42
 528         apply_patch(<<'EOPATCH');
 529 diff --git a/Configure b/Configure
 530 index 3d3b38d..78ffe16 100755
 531 --- a/Configure
 532 +++ b/Configure
 533 @@ -3935,7 +4045,8 @@ $rm -f try.c
 534
 535  : see if the directory entry stores field length
 536  echo " "
 537 -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
 538 +$cppstdin $cppflags $cppminus < "$xinc" > try.c
 539 +if $contains 'd_namlen' try.c >/dev/null 2>&1; then
 540         echo "Good, your directory entry keeps length information in d_namlen." >&4
 541         val="$define"
 542  else
 543 EOPATCH
 544     }
 545 }
 546
 547 if ($major < 5 && extract_from_file('Configure',
 548                                     qr/^if test ! -t 0; then$/)) {
 549     # Before dfe9444ca7881e71, Configure would refuse to run if stdin was not a
 550     # tty. With that commit, the tty requirement was dropped for -de and -dE
 551     # For those older versions, it's probably easiest if we simply remove the
 552     # sanity test.
 553     apply_patch(<<'EOPATCH');
 554 diff --git a/Configure b/Configure
 555 index 0071a7c..8a61caa 100755
 556 --- a/Configure
 557 +++ b/Configure
 558 @@ -93,7 +93,2 @@ esac
 559
 560 -: Sanity checks
 561 -if test ! -t 0; then
 562 -       echo "Say 'sh $me', not 'sh <$me'"
 563 -       exit 1
 564 -fi
 565
 566 EOPATCH
 567 }
 568
 569 if ($major < 10 && extract_from_file('Configure', qr/^set malloc\.h i_malloc$/)) {
 570     # This is commit 01d07975f7ef0e7d, trimmed, with $compile inlined as
 571     # prior to bd9b35c97ad661cc Configure had the malloc.h test before the
 572     # definition of $compile.
 573     apply_patch(<<'EOPATCH');
 574 diff --git a/Configure b/Configure
 575 index 3d2e8b9..6ce7766 100755
 576 --- a/Configure
 577 +++ b/Configure
 578 @@ -6743,5 +6743,22 @@ set d_dosuid
 579
 580  : see if this is a malloc.h system
 581 -set malloc.h i_malloc
 582 -eval $inhdr
 583 +: we want a real compile instead of Inhdr because some systems have a
 584 +: malloc.h that just gives a compile error saying to use stdlib.h instead
 585 +echo " "
 586 +$cat >try.c <<EOCP
 587 +#include <stdlib.h>
 588 +#include <malloc.h>
 589 +int main () { return 0; }
 590 +EOCP
 591 +set try
 592 +if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then
 593 +    echo "<malloc.h> found." >&4
 594 +    val="$define"
 595 +else
 596 +    echo "<malloc.h> NOT found." >&4
 597 +    val="$undef"
 598 +fi
 599 +$rm -f try.c try
 600 +set i_malloc
 601 +eval $setvar
 602
 603 EOPATCH
 604 }
 605
 606 if ($major < 10 && -d 'ext/Unicode/Normalize/'
 607     && !extract_from_file('Configure', qr/^extra_dep=''$/)) {
 608     # The Makefile.PL for Unicode::Normalize needs
 609     # lib/unicore/CombiningClass.pl. Even without a parallel build, we need
 610     # a dependency to ensure that it builds. This is a variant of commit
 611     # 9f3ef600c170f61e
 612     apply_patch(<<'EOPATCH');
 613 diff --git a/Makefile.SH b/Makefile.SH
 614 index f61d0db..6097954 100644
 615 --- a/Makefile.SH
 616 +++ b/Makefile.SH
 617 @@ -155,10 +155,20 @@ esac
 618
 619  : Prepare dependency lists for Makefile.
 620  dynamic_list=' '
 621 +extra_dep=''
 622  for f in $dynamic_ext; do
 623      : the dependency named here will never exist
 624        base=`echo "$f" | sed 's/.*\///'`
 625 -    dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext"
 626 +    this_target="lib/auto/$f/$base.$dlext"
 627 +    dynamic_list="$dynamic_list $this_target"
 628 +
 629 +    : Parallel makes reveal that we have some interdependencies
 630 +    case $f in
 631 +       Math/BigInt/FastCalc) extra_dep="$extra_dep
 632 +$this_target: lib/auto/List/Util/Util.$dlext" ;;
 633 +       Unicode/Normalize) extra_dep="$extra_dep
 634 +$this_target: lib/unicore/CombiningClass.pl" ;;
 635 +    esac
 636  done
 637
 638  static_list=' '
 639 @@ -987,2 +997,9 @@ n_dummy $(nonxs_ext):       miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE
 640         @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
 641 +!NO!SUBS!
 642 +
 643 +$spitshell >>Makefile <<EOF
 644 +$extra_dep
 645 +EOF
 646 +
 647 +$spitshell >>Makefile <<'!NO!SUBS!'
 648
 649 EOPATCH
 650 }
 651
 652 # There was a bug in makedepend.SH which was fixed in version 96a8704c.
 653 # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
 654 # Remove this if you're actually bisecting a problem related to makedepend.SH
 655 system 'git show blead:makedepend.SH > makedepend.SH </dev/null' and die;
 656
 657 if ($^O eq 'freebsd') {
 658     # There are rather too many version-specific FreeBSD hints fixes to patch
 659     # individually. Also, more than once the FreeBSD hints file has been
 660     # written in what turned out to be a rather non-future-proof style,
 661     # with case statements treating the most recent version as the exception,
 662     # instead of treating previous versions' behaviour explicitly and changing
 663     # the default to cater for the current behaviour. (As strangely, future
 664     # versions inherit the current behaviour.)
 665     system 'git show blead:hints/freebsd.sh > hints/freebsd.sh </dev/null'
 666       and die;
 667
 668     if ($major < 2) {
 669         # 5.002 Configure and later have code to
 670         #
 671         # : Try to guess additional flags to pick up local libraries.
 672         #
 673         # which will automatically add --L/usr/local/lib because libpth
 674         # contains /usr/local/lib
 675         #
 676         # Without it, if Configure finds libraries in /usr/local/lib (eg
 677         # libgdbm.so) and adds them to the compiler commandline (as -lgdbm),
 678         # then the link will fail. We can't fix this up in config.sh because
 679         # the link will *also* fail in the test compiles that Configure does
 680         # (eg $inlibc) which makes Configure get all sorts of things
 681         # wrong. :-( So bodge it here.
 682         #
 683         # Possibly other platforms will need something similar. (if they
 684         # have "wanted" libraries in /usr/local/lib, but the compiler
 685         # doesn't default to putting that directory in its link path)
 686         apply_patch(<<'EOPATCH');
 687 --- perl2/hints/freebsd.sh.orig 2011-10-05 16:44:55.000000000 +0200
 688 +++ perl2/hints/freebsd.sh      2011-10-05 16:45:52.000000000 +0200
 689 @@ -125,7 +125,7 @@
 690          else
 691              libpth="/usr/lib /usr/local/lib"
 692              glibpth="/usr/lib /usr/local/lib"
 693 -            ldflags="-Wl,-E "
 694 +            ldflags="-Wl,-E -L/usr/local/lib "
 695              lddlflags="-shared "
 696          fi
 697          cccdlflags='-DPIC -fPIC'
 698 @@ -133,7 +133,7 @@
 699  *)
 700         libpth="/usr/lib /usr/local/lib"
 701         glibpth="/usr/lib /usr/local/lib"
 702 -       ldflags="-Wl,-E "
 703 +       ldflags="-Wl,-E -L/usr/local/lib "
 704          lddlflags="-shared "
 705          cccdlflags='-DPIC -fPIC'
 706         ;;
 707 EOPATCH
 708     }
 709 }
 710
 711 # if Encode is not needed for the test, you can speed up the bisect by
 712 # excluding it from the runs with -Dnoextensions=Encode
 713 # ccache is an easy win. Remove it if it causes problems.
 714 # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
 715 # to true in hints/linux.sh
 716 # On dromedary, from that point on, Configure (by default) fails to find any
 717 # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
 718 # versioned libraries. Without -lm, the build fails.
 719 # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
 720 # until commit faae14e6e968e1c0 adds it to the hints.
 721 # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
 722 # because it will spot versioned libraries, pass them to the compiler, and then
 723 # bail out pretty early on. Configure won't let us override libswanted, but it
 724 # will let us override the entire libs list.
 725
 726 unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
 727     # Before 1cfa4ec74d4933da, so force the libs list.
 728
 729     my @libs;
 730     # This is the current libswanted list from Configure, less the libs removed
 731     # by current hints/linux.sh
 732     foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
 733                         ld sun m crypt sec util c cposix posix ucb BSD)) {
 734         foreach my $dir (@paths) {
 735             next unless -f "$dir/lib$lib.so";
 736             push @libs, "-l$lib";
 737             last;
 738         }
 739     }
 740     $defines{libs} = \@libs unless exists $defines{libs};
 741 }
 742
 743 # This seems to be necessary to avoid makedepend becoming confused, and hanging
 744 # on stdin. Seems that the code after make shlist || ...here... is never run.
 745 $defines{trnl} = q{'\n'}
 746     if $major < 4 && !exists $defines{trnl};
 747
 748 $defines{usenm} = undef
 749     if $major < 2 && !exists $defines{usenm};
 750
 751 my (@missing, @created_dirs);
 752
 753 if ($options{'force-manifest'}) {
 754     open my $fh, '<', 'MANIFEST'
 755         or die "Could not open MANIFEST: $!";
 756     while (<$fh>) {
 757         next unless /^(\S+)/;
 758         push @missing, $1
 759             unless -f $1;
 760     }
 761     close $fh or die "Can't close MANIFEST: $!";
 762
 763     foreach my $pathname (@missing) {
 764         my @parts = split '/', $pathname;
 765         my $leaf = pop @parts;
 766         my $path = '.';
 767         while (@parts) {
 768             $path .= '/' . shift @parts;
 769             next if -d $path;
 770             mkdir $path, 0700 or die "Can't create $path: $!";
 771             unshift @created_dirs, $path;
 772         }
 773         open $fh, '>', $pathname or die "Can't open $pathname: $!";
 774         close $fh or die "Can't close $pathname: $!";
 775         chmod 0, $pathname or die "Can't chmod 0 $pathname: $!";
 776     }
 777 }
 778
 779 my @ARGS = $target eq 'config.sh' ? '-dEs' : '-des';
 780 foreach my $key (sort keys %defines) {
 781     my $val = $defines{$key};
 782     if (ref $val) {
 783         push @ARGS, "-D$key=@$val";
 784     } elsif (!defined $val) {
 785         push @ARGS, "-U$key";
 786     } elsif (!length $val) {
 787         push @ARGS, "-D$key";
 788     } else {
 789         $val = "" if $val eq "\0";
 790         push @ARGS, "-D$key=$val";
 791     }
 792 }
 793 push @ARGS, map {"-A$_"} @{$options{A}};
 794
 795 # </dev/null because it seems that some earlier versions of Configure can
 796 # call commands in a way that now has them reading from stdin (and hanging)
 797 my $pid = fork;
 798 die "Can't fork: $!" unless defined $pid;
 799 if (!$pid) {
 800     open STDIN, '<', '/dev/null';
 801     # If a file in MANIFEST is missing, Configure asks if you want to
 802     # continue (the default being 'n'). With stdin closed or /dev/null,
 803     # it exits immediately and the check for config.sh below will skip.
 804     exec './Configure', @ARGS;
 805     die "Failed to start Configure: $!";
 806 }
 807 waitpid $pid, 0
 808     or die "wait for Configure, pid $pid failed: $!";
 809
 810 if ($target =~ /config\.s?h/) {
 811     match_and_exit($target) if $match && -f $target;
 812     report_and_exit(!-f $target, 'could build', 'could not build', $target);
 813 } elsif (!-f 'config.sh') {
 814     # Skip if something went wrong with Configure
 815
 816     skip('could not build config.sh');
 817 }
 818
 819 # This is probably way too paranoid:
 820 if (@missing) {
 821     my @errors;
 822     require Fcntl;
 823     foreach my $file (@missing) {
 824         my (undef, undef, $mode, undef, undef, undef, undef, $size)
 825             = stat $file;
 826         if (!defined $mode) {
 827             push @errors, "Added file $file has been deleted by Configure";
 828             next;
 829         }
 830         if (Fcntl::S_IMODE($mode) != 0) {
 831             push @errors,
 832                 sprintf 'Added file %s had mode changed by Configure to %03o',
 833                     $file, $mode;
 834         }
 835         if ($size != 0) {
 836             push @errors,
 837                 "Added file $file had sized changed by Configure to $size";
 838         }
 839         unlink $file or die "Can't unlink $file: $!";
 840     }
 841     foreach my $dir (@created_dirs) {
 842         rmdir $dir or die "Can't rmdir $dir: $!";
 843     }
 844     skip("@errors")
 845         if @errors;
 846 }
 847
 848 # Correct makefile for newer GNU gcc
 849 # Only really needed if you comment out the use of blead's makedepend.SH
 850 {
 851     local $^I = "";
 852     local @ARGV = qw(makefile x2p/makefile);
 853     while (<>) {
 854         print unless /<(?:built-in|command|stdin)/;
 855     }
 856 }
 857
 858 if ($major == 2 && extract_from_file('perl.c', qr/^     fclose\(e_fp\);$/)) {
 859     # need to patch perl.c to avoid calling fclose() twice on e_fp when using -e
 860     # This diff is part of commit ab821d7fdc14a438. The second close was
 861     # introduced with perl-5.002, commit a5f75d667838e8e7
 862     # Might want a6c477ed8d4864e6 too, for the corresponding change to pp_ctl.c
 863     # (likely without this, eval will have "fun")
 864     apply_patch(<<'EOPATCH');
 865 diff --git a/perl.c b/perl.c
 866 index 03c4d48..3c814a2 100644
 867 --- a/perl.c
 868 +++ b/perl.c
 869 @@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
 870  #ifndef VMS  /* VMS doesn't have environ array */
 871      origenviron = environ;
 872  #endif
 873 +    e_tmpname = Nullch;
 874
 875      if (do_undump) {
 876
 877 @@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
 878      if (e_fp) {
 879         if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
 880             croak("Can't write to temp file for -e: %s", Strerror(errno));
 881 +       e_fp = Nullfp;
 882         argc++,argv--;
 883         scriptname = e_tmpname;
 884      }
 885 @@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
 886      curcop->cop_line = 0;
 887      curstash = defstash;
 888      preprocess = FALSE;
 889 -    if (e_fp) {
 890 -       fclose(e_fp);
 891 -       e_fp = Nullfp;
 892 +    if (e_tmpname) {
 893         (void)UNLINK(e_tmpname);
 894 +       Safefree(e_tmpname);
 895 +       e_tmpname = Nullch;
 896      }
 897
 898      /* now that script is parsed, we can modify record separator */
 899 @@ -1369,7 +1371,7 @@ SV *sv;
 900         scriptname = xfound;
 901      }
 902
 903 -    origfilename = savepv(e_fp ? "-e" : scriptname);
 904 +    origfilename = savepv(e_tmpname ? "-e" : scriptname);
 905      curcop->cop_filegv = gv_fetchfile(origfilename);
 906      if (strEQ(origfilename,"-"))
 907         scriptname = "";
 908
 909 EOPATCH
 910 }
 911
 912 if ($major < 10
 913     && extract_from_file('ext/DB_File/DB_File.xs',
 914                          qr!^#else /\* Berkeley DB Version > 2 \*/$!)
 915     && !extract_from_file('ext/DB_File/DB_File.xs',
 916                           qr/^#ifdef AT_LEAST_DB_4_1$/)) {
 917     # This line is changed by commit 3245f0580c13b3ab
 918     my $line = extract_from_file('ext/DB_File/DB_File.xs',
 919                                  qr/^(        status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/);
 920     apply_patch(<<"EOPATCH");
 921 diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
 922 index 489ba96..fba8ded 100644
 923 --- a/ext/DB_File/DB_File.xs
 924 +++ b/ext/DB_File/DB_File.xs
 925 \@\@ -183,4 +187,8 \@\@
 926  #endif
 927
 928 +#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
 929 +#    define AT_LEAST_DB_4_1
 930 +#endif
 931 +
 932  /* map version 2 features & constants onto their version 1 equivalent */
 933
 934 \@\@ -1334,7 +1419,12 \@\@ SV *   sv ;
 935  #endif
 936
 937 +#ifdef AT_LEAST_DB_4_1
 938 +        status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
 939 +                               Flags, mode) ;
 940 +#else
 941  $line
 942                                 Flags, mode) ;
 943 +#endif
 944         /* printf("open returned %d %s\\n", status, db_strerror(status)) ; */
 945
 946 EOPATCH
 947 }
 948
 949 if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') {
 950     edit_file('ext/IPC/SysV/SysV.xs', sub {
 951                   my $xs = shift;
 952                   my $fixed = <<'EOFIX';
 953
 954 #include <sys/types.h>
 955 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 956 #ifndef HAS_SEM
 957 #   include <sys/ipc.h>
 958 #endif
 959 #   ifdef HAS_MSG
 960 #       include <sys/msg.h>
 961 #   endif
 962 #   ifdef HAS_SHM
 963 #       if defined(PERL_SCO) || defined(PERL_ISC)
 964 #           include <sys/sysmacros.h>   /* SHMLBA */
 965 #       endif
 966 #      include <sys/shm.h>
 967 #      ifndef HAS_SHMAT_PROTOTYPE
 968            extern Shmat_t shmat (int, char *, int);
 969 #      endif
 970 #      if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
 971 #          undef  SHMLBA /* not static: determined at boot time */
 972 #          define SHMLBA sysconf(_SC_PAGESIZE)
 973 #      elif defined(HAS_GETPAGESIZE)
 974 #          undef  SHMLBA /* not static: determined at boot time */
 975 #          define SHMLBA getpagesize()
 976 #      endif
 977 #   endif
 978 #endif
 979 EOFIX
 980                   $xs =~ s!
 981 #include <sys/types\.h>
 982 .*
 983 (#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms;
 984                   return $xs;
 985               });
 986 }
 987
 988 # Parallel build for miniperl is safe
 989 system "make $j miniperl </dev/null";
 990
 991 my $expected = $target =~ /^test/ ? 't/perl'
 992     : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}"
 993     : $target;
 994 my $real_target = $target eq 'Fcntl' ? $expected : $target;
 995
 996 if ($target ne 'miniperl') {
 997     # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
 998     $j = '' if $major < 10;
 999
1000     if ($real_target eq 'test_prep') {
1001         if ($major < 8) {
1002             # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
1003             # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
1004             # earlier than that, just make test. It will be fast enough.
1005             $real_target = extract_from_file('Makefile.SH',
1006                                              qr/^(test[-_]prep):/,
1007                                              'test');
1008         }
1009     }
1010
1011     system "make $j $real_target </dev/null";
1012 }
1013
1014 my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;
1015
1016 if ($options{'test-build'}) {
1017     report_and_exit($missing_target, 'could build', 'could not build',
1018                     $real_target);
1019 } elsif ($missing_target) {
1020     skip("could not build $real_target");
1021 }
1022
1023 match_and_exit($real_target) if $match;
1024
1025 if (defined $options{'one-liner'}) {
1026     my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl';
1027     unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'};
1028 }
1029
1030 # This is what we came here to run:
1031 my $ret = system @ARGV;
1032
1033 report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
1034
1035 # Local variables:
1036 # cperl-indent-level: 4
1037 # indent-tabs-mode: nil
1038 # End:
1039 #
1040 # ex: set ts=8 sts=4 sw=4 et: