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 -- ./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 F<bisect.pl> and F<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 F<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>. F<bisect.pl> will use F<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 F<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 By default, F<bisect-runner.pl> will automatically disable the build of
 145 L<DB_File> for commits earlier than ccb44e3bf3be2c30, as it's not practical
 146 to patch DB_File 1.70 and earlier to build with current Berkeley DB headers.
 147 (ccb44e3bf3be2c30 was in September 1999, between 5.005_62 and 5.005_63.)
 148 If your F<db.h> is old enough you can override this with C<-Unoextensions>.
 149
 150 =head1 OPTIONS
 151
 152 =over 4
 153
 154 =item *
 155
 156 --start I<commit-ish>
 157
 158 Earliest revision to test, as a I<commit-ish> (a tag, commit or anything
 159 else C<git> understands as a revision). If not specified, F<bisect.pl> will
 160 search stable perl releases from 5.002 to 5.14.0 until it finds one where
 161 the test case passes.
 162
 163 =item *
 164
 165 --end I<commit-ish>
 166
 167 Most recent revision to test, as a I<commit-ish>. If not specified, defaults
 168 to I<blead>.
 169
 170 =item *
 171
 172 --target I<target>
 173
 174 F<Makefile> target (or equivalent) needed, to run the test case. If specified,
 175 this should be one of
 176
 177 =over 4
 178
 179 =item *
 180
 181 I<config.sh>
 182
 183 Just run F<./Configure>
 184
 185 =item *
 186
 187 I<config.h>
 188
 189 Run the various F<*.SH> files to generate F<Makefile>, F<config.h>, I<etc>.
 190
 191 =item *
 192
 193 I<miniperl>
 194
 195 Build F<miniperl>.
 196
 197 =item *
 198
 199 I<lib/Config.pm>
 200
 201 Use F<miniperl> to build F<lib/Config.pm>
 202
 203 =item *
 204
 205 I<Fcntl>
 206
 207 Build F<lib/auto/Fcntl/Fnctl.so> (strictly, C<.$Config{so}>). As L<Fcntl>
 208 is simple XS module present since 5.000, this provides a fast test of
 209 whether XS modules can be built. Note, XS modules are built by F<miniperl>,
 210 hence this target will not build F<perl>.
 211
 212 =item *
 213
 214 I<perl>
 215
 216 Build F<perl>. This also builds pure-Perl modules in F<cpan>, F<dist> and
 217 F<ext>. XS modules (such as L<Fcntl>) are not built.
 218
 219 =item *
 220
 221 I<test_prep>
 222
 223 Build everything needed to run the tests. This is the default if we're
 224 running test code, but is time consuming, as it means building all
 225 XS modules. For older F<Makefile>s, the previous name of C<test-prep>
 226 is automatically substituted. For very old F<Makefile>s, C<make test> is
 227 run, as there is no target provided to just get things ready, and for 5.004
 228 and earlier the tests run very quickly.
 229
 230 =back
 231
 232 =item *
 233
 234 --one-liner 'code to run'
 235
 236 =item *
 237
 238 -e 'code to run'
 239
 240 Example code to run, just like you'd use with C<perl -e>.
 241
 242 This prepends C<./perl -Ilib -e 'code to run'> to the test case given,
 243 or F<./miniperl> if I<target> is C<miniperl>.
 244
 245 (Usually you'll use C<-e> instead of providing a test case in the
 246 non-option arguments to F<bisect.pl>)
 247
 248 C<-E> intentionally isn't supported, as it's an error in 5.8.0 and earlier,
 249 which interferes with detecting errors in the example code itself.
 250
 251 =item *
 252
 253 --expect-fail
 254
 255 The test case should fail for the I<start> revision, and pass for the I<end>
 256 revision. The bisect run will find the first commit where it passes.
 257
 258 =item *
 259
 260 -Dnoextensions=Encode
 261
 262 =item *
 263
 264 -Uusedevel
 265
 266 =item *
 267
 268 -Accflags=-DNO_MATHOMS
 269
 270 Arguments to pass to F<Configure>. Repeated C<-A> arguments are passed
 271 through as is. C<-D> and C<-U> are processed in order, and override
 272 previous settings for the same parameter. F<bisect-runner.pl> emulates
 273 C<-Dnoextensions> when F<Configure> itself does not provide it, as it's
 274 often very useful to be able to disable some XS extensions.
 275
 276 =item *
 277
 278 --jobs I<jobs>
 279
 280 =item *
 281
 282 -j I<jobs>
 283
 284 Number of C<make> jobs to run in parallel. If F</proc/cpuinfo> exists and
 285 can be parsed, or F</sbin/sysctl> exists and reports C<hw.ncpu>, or
 286 F</usr/bin/getconf> exists and reports C<_NPROCESSORS_ONLN> defaults to 1 +
 287 I<number of CPUs>. Otherwise defaults to 2.
 288
 289 =item *
 290
 291 --match pattern
 292
 293 Instead of running a test program to determine I<pass> or I<fail>, pass
 294 if the given regex matches, and hence search for the commit that removes
 295 the last matching file.
 296
 297 If no I<target> is specified, the match is against all files in the
 298 repository (which is fast). If a I<target> is specified, that target is
 299 built, and the match is against only the built files. C<--expect-fail> can
 300 be used with C<--match> to search for a commit that adds files that match.
 301
 302 =item *
 303
 304 --test-build
 305
 306 Test that the build completes, without running any test case.
 307
 308 By default, if the build for the desired I<target> fails to complete,
 309 F<bisect-runner.pl> reports a I<skip> back to C<git bisect>, the assumption
 310 being that one wants to find a commit which changed state "builds && passes"
 311 to "builds && fails". If instead one is interested in which commit broke the
 312 build (possibly for particular F<Configure> options), use I<--test-build>
 313 to treat a build failure as a failure, not a "skip".
 314
 315 Often this option isn't as useful as it first seems, because I<any> build
 316 failure will be reported to C<git bisect> as a failure, not just the failure
 317 that you're interested in. Generally, to debug a particular problem, it's
 318 more useful to use a I<target> that builds properly at the point of interest,
 319 and then a test case that runs C<make>. For example:
 320
 321     .../Porting/bisect.pl --start=perl-5.000 --end=perl-5.002 \
 322         --expect-fail --force-manifest --target=miniperl make perl
 323
 324 will find the first revision capable of building L<DynaLoader> and then
 325 F<perl>, without becoming confused by revisions where F<miniperl> won't
 326 even link.
 327
 328 =item *
 329
 330 --force-manifest
 331
 332 By default, a build will "skip" if any files listed in F<MANIFEST> are not
 333 present. Usually this is useful, as it avoids false-failures. However, there
 334 are some long ranges of commits where listed files are missing, which can
 335 cause a bisect to abort because all that remain are skipped revisions.
 336
 337 In these cases, particularly if the test case uses F<miniperl> and no modules,
 338 it may be more useful to force the build to continue, even if files
 339 F<MANIFEST> are missing.
 340
 341 =item *
 342
 343 --expect-pass [0|1]
 344
 345 C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1> is the default.
 346
 347 =item *
 348
 349 --no-clean
 350
 351 Tell F<bisect-runner.pl> not to clean up after the build. This allows one
 352 to use F<bisect-runner.pl> to build the current particular perl revision for
 353 interactive testing, or for debugging F<bisect-runner.pl>.
 354
 355 Passing this to F<bisect.pl> will likely cause the bisect to fail badly.
 356
 357 =item *
 358
 359 --check-args
 360
 361 Validate the options and arguments, and exit silently if they are valid.
 362
 363 =item *
 364
 365 --usage
 366
 367 =item *
 368
 369 --help
 370
 371 =item *
 372
 373 -?
 374
 375 Display the usage information and exit.
 376
 377 =back
 378
 379 =cut
 380
 381 die "$0: Can't build $target" if defined $target && !grep {@targets} $target;
 382
 383 $j = "-j$j" if $j =~ /\A\d+\z/;
 384
 385 # Sadly, however hard we try, I don't think that it will be possible to build
 386 # modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29,
 387 # which updated to MakeMaker 3.7, which changed from using a hard coded ld
 388 # in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc.
 389
 390 sub extract_from_file {
 391     my ($file, $rx, $default) = @_;
 392     open my $fh, '<', $file or die "Can't open $file: $!";
 393     while (<$fh>) {
 394         my @got = $_ =~ $rx;
 395         return wantarray ? @got : $got[0]
 396             if @got;
 397     }
 398     return $default if defined $default;
 399     return;
 400 }
 401
 402 sub edit_file {
 403     my ($file, $munger) = @_;
 404     local $/;
 405     open my $fh, '<', $file or die "Can't open $file: $!";
 406     my $orig = <$fh>;
 407     die "Can't read $file: $!" unless defined $orig && close $fh;
 408     my $new = $munger->($orig);
 409     return if $new eq $orig;
 410     open $fh, '>', $file or die "Can't open $file: $!";
 411     print $fh $new or die "Can't print to $file: $!";
 412     close $fh or die "Can't close $file: $!";
 413 }
 414
 415 sub apply_patch {
 416     my $patch = shift;
 417
 418     my ($file) = $patch =~ qr!^diff.*a/(\S+) b/\1!;
 419     open my $fh, '|-', 'patch', '-p1' or die "Can't run patch: $!";
 420     print $fh $patch;
 421     return if close $fh;
 422     print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n";
 423     die "Can't patch $file: $?, $!";
 424 }
 425
 426 sub clean {
 427     if ($options{clean}) {
 428         # Needed, because files that are build products in this checked out
 429         # version might be in git in the next desired version.
 430         system 'git clean -dxf </dev/null';
 431         # Needed, because at some revisions the build alters checked out files.
 432         # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
 433         system 'git reset --hard HEAD </dev/null';
 434     }
 435 }
 436
 437 sub skip {
 438     my $reason = shift;
 439     clean();
 440     warn "skipping - $reason";
 441     exit 125;
 442 }
 443
 444 sub report_and_exit {
 445     my ($ret, $pass, $fail, $desc) = @_;
 446
 447     clean();
 448
 449     my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad';
 450     if ($ret) {
 451         print "$got - $fail $desc\n";
 452     } else {
 453         print "$got - $pass $desc\n";
 454     }
 455
 456     exit($got eq 'bad');
 457 }
 458
 459 sub match_and_exit {
 460     my $target = shift;
 461     my $matches = 0;
 462     my $re = qr/$match/;
 463     my @files;
 464
 465     {
 466         local $/ = "\0";
 467         @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`;
 468         chomp @files;
 469     }
 470
 471     foreach my $file (@files) {
 472         open my $fh, '<', $file or die "Can't open $file: $!";
 473         while (<$fh>) {
 474             if ($_ =~ $re) {
 475                 ++$matches;
 476                 if (tr/\t\r\n -~\200-\377//c) {
 477                     print "Binary file $file matches\n";
 478                 } else {
 479                     $_ .= "\n" unless /\n\z/;
 480                     print "$file: $_";
 481                 }
 482             }
 483         }
 484         close $fh or die "Can't close $file: $!";
 485     }
 486     report_and_exit(!$matches,
 487                     $matches == 1 ? '1 match for' : "$matches matches for",
 488                     'no matches for', $match);
 489 }
 490
 491 # Not going to assume that system perl is yet new enough to have autodie
 492 system 'git clean -dxf </dev/null' and die;
 493
 494 if (!defined $target) {
 495     match_and_exit() if $match;
 496     $target = 'test_prep';
 497 }
 498
 499 skip('no Configure - is this the //depot/perlext/Compiler branch?')
 500     unless -f 'Configure';
 501
 502 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
 503 my $major
 504     = extract_from_file('patchlevel.h',
 505                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
 506                         0);
 507
 508 if ($major < 1) {
 509     if (extract_from_file('Configure',
 510                           qr/^          \*=\*\) echo "\$1" >> \$optdef;;$/)) {
 511         # This is "        Spaces now allowed in -D command line options.",
 512         # 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 @@ -652,7 +777,8 @@ while test $# -gt 0; do
 519                         echo "$me: use '-U symbol=', not '-D symbol='." >&2
 520                         echo "$me: ignoring -D $1" >&2
 521                         ;;
 522 -               *=*) echo "$1" >> $optdef;;
 523 +               *=*) echo "$1" | \
 524 +                               sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;;
 525                 *) echo "$1='define'" >> $optdef;;
 526                 esac
 527                 shift
 528 EOPATCH
 529     }
 530     if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) {
 531         # Configure's original simple "grep" for d_namlen falls foul of the
 532         # approach taken by the glibc headers:
 533         # #ifdef _DIRENT_HAVE_D_NAMLEN
 534         # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen)
 535         #
 536         # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux.
 537         # This is also part of commit ecfc54246c2a6f42
 538         apply_patch(<<'EOPATCH');
 539 diff --git a/Configure b/Configure
 540 index 3d3b38d..78ffe16 100755
 541 --- a/Configure
 542 +++ b/Configure
 543 @@ -3935,7 +4045,8 @@ $rm -f try.c
 544
 545  : see if the directory entry stores field length
 546  echo " "
 547 -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
 548 +$cppstdin $cppflags $cppminus < "$xinc" > try.c
 549 +if $contains 'd_namlen' try.c >/dev/null 2>&1; then
 550         echo "Good, your directory entry keeps length information in d_namlen." >&4
 551         val="$define"
 552  else
 553 EOPATCH
 554     }
 555 }
 556
 557 if ($major < 8 && !extract_from_file('Configure',
 558                                     qr/^\t\tif test ! -t 0; then$/)) {
 559     # Before dfe9444ca7881e71, Configure would refuse to run if stdin was not a
 560     # tty. With that commit, the tty requirement was dropped for -de and -dE
 561     # Commit aaeb8e512e8e9e14 dropped the tty requirement for -S
 562     # For those older versions, it's probably easiest if we simply remove the
 563     # sanity test.
 564     edit_file('Configure', sub {
 565                   my $code = shift;
 566                   $code =~ s/test ! -t 0/test Perl = rules/;
 567                   return $code;
 568               });
 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 ($major < 10) {
 714     if (!extract_from_file('ext/DB_File/DB_File.xs',
 715                            qr!^#else /\* Berkeley DB Version > 2 \*/$!)) {
 716         # This DB_File.xs is really too old to patch up.
 717         # Skip DB_File, unless we're invoked with an explicit -Unoextensions
 718         if (!exists $defines{noextensions}) {
 719             $defines{noextensions} = 'DB_File';
 720         } elsif (defined $defines{noextensions}) {
 721             $defines{noextensions} .= ' DB_File';
 722         }
 723     } elsif (!extract_from_file('ext/DB_File/DB_File.xs',
 724                                 qr/^#ifdef AT_LEAST_DB_4_1$/)) {
 725         # This line is changed by commit 3245f0580c13b3ab
 726         my $line = extract_from_file('ext/DB_File/DB_File.xs',
 727                                      qr/^(        status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/);
 728         apply_patch(<<"EOPATCH");
 729 diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
 730 index 489ba96..fba8ded 100644
 731 --- a/ext/DB_File/DB_File.xs
 732 +++ b/ext/DB_File/DB_File.xs
 733 \@\@ -183,4 +187,8 \@\@
 734  #endif
 735
 736 +#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
 737 +#    define AT_LEAST_DB_4_1
 738 +#endif
 739 +
 740  /* map version 2 features & constants onto their version 1 equivalent */
 741
 742 \@\@ -1334,7 +1419,12 \@\@ SV *   sv ;
 743  #endif
 744
 745 +#ifdef AT_LEAST_DB_4_1
 746 +        status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
 747 +                               Flags, mode) ;
 748 +#else
 749  $line
 750                                 Flags, mode) ;
 751 +#endif
 752         /* printf("open returned %d %s\\n", status, db_strerror(status)) ; */
 753
 754 EOPATCH
 755     }
 756 }
 757
 758 # if Encode is not needed for the test, you can speed up the bisect by
 759 # excluding it from the runs with -Dnoextensions=Encode
 760 # ccache is an easy win. Remove it if it causes problems.
 761 # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
 762 # to true in hints/linux.sh
 763 # On dromedary, from that point on, Configure (by default) fails to find any
 764 # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
 765 # versioned libraries. Without -lm, the build fails.
 766 # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
 767 # until commit faae14e6e968e1c0 adds it to the hints.
 768 # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
 769 # because it will spot versioned libraries, pass them to the compiler, and then
 770 # bail out pretty early on. Configure won't let us override libswanted, but it
 771 # will let us override the entire libs list.
 772
 773 unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
 774     # Before 1cfa4ec74d4933da, so force the libs list.
 775
 776     my @libs;
 777     # This is the current libswanted list from Configure, less the libs removed
 778     # by current hints/linux.sh
 779     foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
 780                         ld sun m crypt sec util c cposix posix ucb BSD)) {
 781         foreach my $dir (@paths) {
 782             next unless -f "$dir/lib$lib.so";
 783             push @libs, "-l$lib";
 784             last;
 785         }
 786     }
 787     $defines{libs} = \@libs unless exists $defines{libs};
 788 }
 789
 790 # This seems to be necessary to avoid makedepend becoming confused, and hanging
 791 # on stdin. Seems that the code after make shlist || ...here... is never run.
 792 $defines{trnl} = q{'\n'}
 793     if $major < 4 && !exists $defines{trnl};
 794
 795 $defines{usenm} = undef
 796     if $major < 2 && !exists $defines{usenm};
 797
 798 my (@missing, @created_dirs);
 799
 800 if ($options{'force-manifest'}) {
 801     open my $fh, '<', 'MANIFEST'
 802         or die "Could not open MANIFEST: $!";
 803     while (<$fh>) {
 804         next unless /^(\S+)/;
 805         push @missing, $1
 806             unless -f $1;
 807     }
 808     close $fh or die "Can't close MANIFEST: $!";
 809
 810     foreach my $pathname (@missing) {
 811         my @parts = split '/', $pathname;
 812         my $leaf = pop @parts;
 813         my $path = '.';
 814         while (@parts) {
 815             $path .= '/' . shift @parts;
 816             next if -d $path;
 817             mkdir $path, 0700 or die "Can't create $path: $!";
 818             unshift @created_dirs, $path;
 819         }
 820         open $fh, '>', $pathname or die "Can't open $pathname: $!";
 821         close $fh or die "Can't close $pathname: $!";
 822         chmod 0, $pathname or die "Can't chmod 0 $pathname: $!";
 823     }
 824 }
 825
 826 my @ARGS = '-dEs';
 827 foreach my $key (sort keys %defines) {
 828     my $val = $defines{$key};
 829     if (ref $val) {
 830         push @ARGS, "-D$key=@$val";
 831     } elsif (!defined $val) {
 832         push @ARGS, "-U$key";
 833     } elsif (!length $val) {
 834         push @ARGS, "-D$key";
 835     } else {
 836         $val = "" if $val eq "\0";
 837         push @ARGS, "-D$key=$val";
 838     }
 839 }
 840 push @ARGS, map {"-A$_"} @{$options{A}};
 841
 842 # </dev/null because it seems that some earlier versions of Configure can
 843 # call commands in a way that now has them reading from stdin (and hanging)
 844 my $pid = fork;
 845 die "Can't fork: $!" unless defined $pid;
 846 if (!$pid) {
 847     open STDIN, '<', '/dev/null';
 848     # If a file in MANIFEST is missing, Configure asks if you want to
 849     # continue (the default being 'n'). With stdin closed or /dev/null,
 850     # it exits immediately and the check for config.sh below will skip.
 851     exec './Configure', @ARGS;
 852     die "Failed to start Configure: $!";
 853 }
 854 waitpid $pid, 0
 855     or die "wait for Configure, pid $pid failed: $!";
 856
 857 # Emulate noextensions if Configure doesn't support it.
 858 if (-f 'config.sh') {
 859     if ($major < 10 && $defines{noextensions}) {
 860         edit_file('config.sh', sub {
 861                       my @lines = split /\n/, shift;
 862                       my @ext = split /\s+/, $defines{noextensions};
 863                       foreach (@lines) {
 864                           next unless /^extensions=/ || /^dynamic_ext/;
 865                           foreach my $ext (@ext) {
 866                               s/\b$ext( )?\b/$1/;
 867                           }
 868                       }
 869                       return join "\n", @lines;
 870                   });
 871     }
 872     system './Configure -S </dev/null' and die;
 873 }
 874
 875 if ($target =~ /config\.s?h/) {
 876     match_and_exit($target) if $match && -f $target;
 877     report_and_exit(!-f $target, 'could build', 'could not build', $target);
 878 } elsif (!-f 'config.sh') {
 879     # Skip if something went wrong with Configure
 880
 881     skip('could not build config.sh');
 882 }
 883
 884 # This is probably way too paranoid:
 885 if (@missing) {
 886     my @errors;
 887     require Fcntl;
 888     foreach my $file (@missing) {
 889         my (undef, undef, $mode, undef, undef, undef, undef, $size)
 890             = stat $file;
 891         if (!defined $mode) {
 892             push @errors, "Added file $file has been deleted by Configure";
 893             next;
 894         }
 895         if (Fcntl::S_IMODE($mode) != 0) {
 896             push @errors,
 897                 sprintf 'Added file %s had mode changed by Configure to %03o',
 898                     $file, $mode;
 899         }
 900         if ($size != 0) {
 901             push @errors,
 902                 "Added file $file had sized changed by Configure to $size";
 903         }
 904         unlink $file or die "Can't unlink $file: $!";
 905     }
 906     foreach my $dir (@created_dirs) {
 907         rmdir $dir or die "Can't rmdir $dir: $!";
 908     }
 909     skip("@errors")
 910         if @errors;
 911 }
 912
 913 # Correct makefile for newer GNU gcc
 914 # Only really needed if you comment out the use of blead's makedepend.SH
 915 {
 916     local $^I = "";
 917     local @ARGV = qw(makefile x2p/makefile);
 918     while (<>) {
 919         print unless /<(?:built-in|command|stdin)/;
 920     }
 921 }
 922
 923 if ($major == 2 && extract_from_file('perl.c', qr/^     fclose\(e_fp\);$/)) {
 924     # need to patch perl.c to avoid calling fclose() twice on e_fp when using -e
 925     # This diff is part of commit ab821d7fdc14a438. The second close was
 926     # introduced with perl-5.002, commit a5f75d667838e8e7
 927     # Might want a6c477ed8d4864e6 too, for the corresponding change to pp_ctl.c
 928     # (likely without this, eval will have "fun")
 929     apply_patch(<<'EOPATCH');
 930 diff --git a/perl.c b/perl.c
 931 index 03c4d48..3c814a2 100644
 932 --- a/perl.c
 933 +++ b/perl.c
 934 @@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
 935  #ifndef VMS  /* VMS doesn't have environ array */
 936      origenviron = environ;
 937  #endif
 938 +    e_tmpname = Nullch;
 939
 940      if (do_undump) {
 941
 942 @@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
 943      if (e_fp) {
 944         if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
 945             croak("Can't write to temp file for -e: %s", Strerror(errno));
 946 +       e_fp = Nullfp;
 947         argc++,argv--;
 948         scriptname = e_tmpname;
 949      }
 950 @@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
 951      curcop->cop_line = 0;
 952      curstash = defstash;
 953      preprocess = FALSE;
 954 -    if (e_fp) {
 955 -       fclose(e_fp);
 956 -       e_fp = Nullfp;
 957 +    if (e_tmpname) {
 958         (void)UNLINK(e_tmpname);
 959 +       Safefree(e_tmpname);
 960 +       e_tmpname = Nullch;
 961      }
 962
 963      /* now that script is parsed, we can modify record separator */
 964 @@ -1369,7 +1371,7 @@ SV *sv;
 965         scriptname = xfound;
 966      }
 967
 968 -    origfilename = savepv(e_fp ? "-e" : scriptname);
 969 +    origfilename = savepv(e_tmpname ? "-e" : scriptname);
 970      curcop->cop_filegv = gv_fetchfile(origfilename);
 971      if (strEQ(origfilename,"-"))
 972         scriptname = "";
 973
 974 EOPATCH
 975 }
 976
 977 if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') {
 978     edit_file('ext/IPC/SysV/SysV.xs', sub {
 979                   my $xs = shift;
 980                   my $fixed = <<'EOFIX';
 981
 982 #include <sys/types.h>
 983 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 984 #ifndef HAS_SEM
 985 #   include <sys/ipc.h>
 986 #endif
 987 #   ifdef HAS_MSG
 988 #       include <sys/msg.h>
 989 #   endif
 990 #   ifdef HAS_SHM
 991 #       if defined(PERL_SCO) || defined(PERL_ISC)
 992 #           include <sys/sysmacros.h>   /* SHMLBA */
 993 #       endif
 994 #      include <sys/shm.h>
 995 #      ifndef HAS_SHMAT_PROTOTYPE
 996            extern Shmat_t shmat (int, char *, int);
 997 #      endif
 998 #      if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
 999 #          undef  SHMLBA /* not static: determined at boot time */
1000 #          define SHMLBA sysconf(_SC_PAGESIZE)
1001 #      elif defined(HAS_GETPAGESIZE)
1002 #          undef  SHMLBA /* not static: determined at boot time */
1003 #          define SHMLBA getpagesize()
1004 #      endif
1005 #   endif
1006 #endif
1007 EOFIX
1008                   $xs =~ s!
1009 #include <sys/types\.h>
1010 .*
1011 (#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms;
1012                   return $xs;
1013               });
1014 }
1015
1016 # Parallel build for miniperl is safe
1017 system "make $j miniperl </dev/null";
1018
1019 my $expected = $target =~ /^test/ ? 't/perl'
1020     : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}"
1021     : $target;
1022 my $real_target = $target eq 'Fcntl' ? $expected : $target;
1023
1024 if ($target ne 'miniperl') {
1025     # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
1026     $j = '' if $major < 10;
1027
1028     if ($real_target eq 'test_prep') {
1029         if ($major < 8) {
1030             # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
1031             # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
1032             # earlier than that, just make test. It will be fast enough.
1033             $real_target = extract_from_file('Makefile.SH',
1034                                              qr/^(test[-_]prep):/,
1035                                              'test');
1036         }
1037     }
1038
1039     system "make $j $real_target </dev/null";
1040 }
1041
1042 my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;
1043
1044 if ($options{'test-build'}) {
1045     report_and_exit($missing_target, 'could build', 'could not build',
1046                     $real_target);
1047 } elsif ($missing_target) {
1048     skip("could not build $real_target");
1049 }
1050
1051 match_and_exit($real_target) if $match;
1052
1053 if (defined $options{'one-liner'}) {
1054     my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl';
1055     unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'};
1056 }
1057
1058 # This is what we came here to run:
1059 my $ret = system @ARGV;
1060
1061 report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
1062
1063 # Local variables:
1064 # cperl-indent-level: 4
1065 # indent-tabs-mode: nil
1066 # End:
1067 #
1068 # ex: set ts=8 sts=4 sw=4 et: