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