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 %options =
  12     (
  13      'expect-pass' => 1,
  14      clean => 1, # mostly for debugging this
  15     );
  16
  17 # We accept #!./miniperl and #!./perl
  18 # We don't accept #!miniperl and #!perl as their intent is ambiguous
  19 my $run_with_our_perl = qr{\A#!(\./(?:mini)?perl)\b};
  20
  21 my $linux64 = `uname -sm` eq "Linux x86_64\n" ? '64' : '';
  22
  23 my @paths;
  24
  25 if ($^O eq 'linux') {
  26     # This is the search logic for a multi-arch library layout
  27     # added to linux.sh in commits 40f026236b9959b7 and dcffd848632af2c7.
  28     my $gcc = -x '/usr/bin/gcc' ? '/usr/bin/gcc' : 'gcc';
  29
  30     foreach (`$gcc -print-search-dirs`) {
  31         next unless /^libraries: =(.*)/;
  32         foreach (split ':', $1) {
  33             next if m/gcc/;
  34             next unless -d $_;
  35             s!/$!!;
  36             push @paths, $_;
  37         }
  38     }
  39     push @paths, map {$_ . $linux64} qw(/usr/local/lib /lib /usr/lib)
  40         if $linux64;
  41 }
  42
  43 my %defines =
  44     (
  45      usedevel => '',
  46      optimize => '-g',
  47      ld => 'cc',
  48      (@paths ? (libpth => \@paths) : ()),
  49     );
  50
  51 # Needed for the 'ignore_versioned_solibs' emulation below.
  52 push @paths, qw(/usr/local/lib /lib /usr/lib)
  53         unless $linux64;
  54
  55 unless(GetOptions(\%options,
  56                   'target=s', 'make=s', 'jobs|j=i', 'expect-pass=i',
  57                   'expect-fail' => sub { $options{'expect-pass'} = 0; },
  58                   'clean!', 'one-liner|e=s', 'c', 'l', 'w', 'match=s',
  59                   'no-match=s' => sub {
  60                       $options{match} = $_[1];
  61                       $options{'expect-pass'} = 0;
  62                   },
  63                   'force-manifest', 'force-regen', 'setpgrp!', 'timeout=i',
  64                   'test-build', 'validate',
  65                   'all-fixups', 'early-fixup=s@', 'late-fixup=s@', 'valgrind',
  66                   'check-args', 'check-shebang!', 'usage|help|?', 'gold=s',
  67                   'A=s@',
  68                   'D=s@' => sub {
  69                       my (undef, $val) = @_;
  70                       if ($val =~ /\A([^=]+)=(.*)/s) {
  71                           $defines{$1} = length $2 ? $2 : "\0";
  72                       } else {
  73                           $defines{$val} = '';
  74                       }
  75                   },
  76                   'U=s@' => sub {
  77                       $defines{$_[1]} = undef;
  78                   },
  79                  )) {
  80     pod2usage(exitval => 255, verbose => 1);
  81 }
  82
  83 my ($target, $match) = @options{qw(target match)};
  84
  85 @ARGV = ('sh', '-c', 'cd t && ./perl TEST base/*.t')
  86     if $options{validate} && !@ARGV;
  87
  88 pod2usage(exitval => 0, verbose => 2) if $options{usage};
  89 pod2usage(exitval => 255, verbose => 1)
  90     unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'};
  91 pod2usage(exitval => 255, verbose => 1)
  92     if !$options{'one-liner'} && ($options{l} || $options{w});
  93
  94 check_shebang($ARGV[0])
  95     if $options{'check-shebang'} && @ARGV && !$options{match};
  96
  97 exit 0 if $options{'check-args'};
  98
  99 =head1 NAME
 100
 101 bisect.pl - use git bisect to pinpoint changes
 102
 103 =head1 SYNOPSIS
 104
 105     # When did this become an error?
 106     .../Porting/bisect.pl -e 'my $a := 2;'
 107     # When did this stop being an error?
 108     .../Porting/bisect.pl --expect-fail -e '1 // 2'
 109     # When were all lines matching this pattern removed from all files?
 110     .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b'
 111     # When was some line matching this pattern added to some file?
 112     .../Porting/bisect.pl --expect-fail --match '\buseithreads\b'
 113     # When did this test program stop exiting 0?
 114     .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl
 115     # When did this test start failing?
 116     .../Porting/bisect.pl -- ./perl -Ilib t/TEST op/sort.t
 117     # When did this first become valid syntax?
 118     .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \
 119          --expect-fail -e 'my $a := 2;'
 120     # What was the last revision to build with these options?
 121     .../Porting/bisect.pl --test-build -Dd_dosuid
 122     # When did this test program start generating errors from valgrind?
 123     .../Porting/bisect.pl --valgrind ../test_prog.pl
 124
 125 =head1 DESCRIPTION
 126
 127 Together F<bisect.pl> and F<bisect-runner.pl> attempt to automate the use
 128 of C<git bisect> as much as possible. With one command (and no other files)
 129 it's easy to find out
 130
 131 =over 4
 132
 133 =item *
 134
 135 Which commit caused this example code to break?
 136
 137 =item *
 138
 139 Which commit caused this example code to start working?
 140
 141 =item *
 142
 143 Which commit added the first file to match this regex?
 144
 145 =item *
 146
 147 Which commit removed the last file to match this regex?
 148
 149 =back
 150
 151 usually without needing to know which versions of perl to use as start and
 152 end revisions.
 153
 154 By default F<bisect.pl> will process all options, then use the rest of the
 155 command line as arguments to list C<system> to run a test case. By default,
 156 the test case should pass (exit with 0) on earlier perls, and fail (exit
 157 non-zero) on I<blead> (note that running most of perl's test files directly
 158 won't do this, you'll need to run them through a harness to get the proper
 159 error code). F<bisect.pl> will use F<bisect-runner.pl> to find the earliest
 160 stable perl version on which the test case passes, check that it fails on
 161 blead, and then use F<bisect-runner.pl> with C<git bisect run> to find the
 162 commit which caused the failure.
 163
 164 Because the test case is the complete argument to C<system>, it is easy to
 165 run something other than the F<perl> built, if necessary. If you need to run
 166 the perl built, you'll probably need to invoke it as C<./perl -Ilib ...>.
 167 As a special case, if the first argument of the test case is a readable file
 168 (whether executable or not), matching C<qr{\A#!./(?:mini)?perl\b}> then it
 169 will have C<./perl> <-Ilib> (or C<./miniperl>) prepended to it.
 170
 171 You need a clean checkout to run a bisect, and you can't use the checkout
 172 which contains F<Porting/bisect.pl> (because C<git bisect>) will check out
 173 a revision before F<Porting/bisect-runner.pl> was added, which
 174 C<git bisect run> needs). If your working checkout is called F<perl>, the
 175 simplest solution is to make a local clone, and run from that. I<i.e.>:
 176
 177     cd ..
 178     git clone perl perl2
 179     cd perl2
 180     ../perl/Porting/bisect.pl ...
 181
 182 By default, F<bisect-runner.pl> will automatically disable the build of
 183 L<DB_File> for commits earlier than ccb44e3bf3be2c30, as it's not practical
 184 to patch DB_File 1.70 and earlier to build with current Berkeley DB headers.
 185 (ccb44e3bf3be2c30 was in September 1999, between 5.005_62 and 5.005_63.)
 186 If your F<db.h> is old enough you can override this with C<-Unoextensions>.
 187
 188 =head1 OPTIONS
 189
 190 =over 4
 191
 192 =item *
 193
 194 --start I<commit-ish>
 195
 196 Earliest revision to test, as a I<commit-ish> (a tag, commit or anything
 197 else C<git> understands as a revision). If not specified, F<bisect.pl> will
 198 search stable .0 perl releases until it finds one where the test case passes
 199 (5.16.0 at the time of writing). The default is to search from 5.002 to the
 200 most recent tagged stable release.  If F<bisect.pl> detects that the
 201 checkout is on a case insensitive file system, it will search from 5.005 to
 202 the most recent tagged stable release. Only .0 stable releases are used
 203 because these are the only stable releases that are parents of blead, and
 204 hence suitable for a bisect run.
 205
 206 =item *
 207
 208 --end I<commit-ish>
 209
 210 Most recent revision to test, as a I<commit-ish>. If not specified, defaults
 211 to I<blead>.
 212
 213 =item *
 214
 215 --target I<target>
 216
 217 F<Makefile> target (or equivalent) needed, to run the test case. If specified,
 218 this should be one of
 219
 220 =over 4
 221
 222 =item *
 223
 224 I<config.sh>
 225
 226 Just run F<./Configure>
 227
 228 =item *
 229
 230 I<config.h>
 231
 232 Run the various F<*.SH> files to generate F<Makefile>, F<config.h>, I<etc>.
 233
 234 =item *
 235
 236 I<miniperl>
 237
 238 Build F<miniperl>.
 239
 240 =item *
 241
 242 I<lib/Config.pm>
 243
 244 Use F<miniperl> to build F<lib/Config.pm>
 245
 246 =item *
 247
 248 I<Fcntl>
 249
 250 Build F<lib/auto/Fcntl/Fnctl.so> (strictly, C<.$Config{so}>). As L<Fcntl>
 251 is simple XS module present since 5.000, this provides a fast test of
 252 whether XS modules can be built. Note, XS modules are built by F<miniperl>,
 253 hence this target will not build F<perl>.
 254
 255 =item *
 256
 257 I<perl>
 258
 259 Build F<perl>. This also builds pure-Perl modules in F<cpan>, F<dist> and
 260 F<ext>. XS modules (such as L<Fcntl>) are not built.
 261
 262 =item *
 263
 264 I<test_prep>
 265
 266 Build everything needed to run the tests. This is the default if we're
 267 running test code, but is time consuming, as it means building all
 268 XS modules. For older F<Makefile>s, the previous name of C<test-prep>
 269 is automatically substituted. For very old F<Makefile>s, C<make test> is
 270 run, as there is no target provided to just get things ready, and for 5.004
 271 and earlier the tests run very quickly.
 272
 273 =back
 274
 275 =item *
 276
 277 --one-liner 'code to run'
 278
 279 =item *
 280
 281 -e 'code to run'
 282
 283 Example code to run, just like you'd use with C<perl -e>.
 284
 285 This prepends C<./perl -Ilib -e 'code to run'> to the test case given,
 286 or F<./miniperl> if I<target> is C<miniperl>.
 287
 288 (Usually you'll use C<-e> instead of providing a test case in the
 289 non-option arguments to F<bisect.pl>)
 290
 291 C<-E> intentionally isn't supported, as it's an error in 5.8.0 and earlier,
 292 which interferes with detecting errors in the example code itself.
 293
 294 =item *
 295
 296 -c
 297
 298 Add C<-c> to the command line, to cause perl to exit after syntax checking.
 299
 300 =item *
 301
 302 -l
 303
 304 Add C<-l> to the command line with C<-e>
 305
 306 This will automatically append a newline to every output line of your testcase.
 307 Note that you can't specify an argument to F<perl>'s C<-l> with this, as it's
 308 not feasible to emulate F<perl>'s somewhat quirky switch parsing with
 309 L<Getopt::Long>. If you need the full flexibility of C<-l>, you need to write
 310 a full test case, instead of using C<bisect.pl>'s C<-e> shortcut.
 311
 312 =item *
 313
 314 -w
 315
 316 Add C<-w> to the command line with C<-e>
 317
 318 It's not valid to pass C<-c>,  C<-l> or C<-w> to C<bisect.pl> unless you are
 319 also using C<-e>
 320
 321 =item *
 322
 323 --expect-fail
 324
 325 The test case should fail for the I<start> revision, and pass for the I<end>
 326 revision. The bisect run will find the first commit where it passes.
 327
 328 =item *
 329
 330 -D I<config_arg=value>
 331
 332 =item *
 333
 334 -U I<config_arg>
 335
 336 =item *
 337
 338 -A I<config_arg=value>
 339
 340 Arguments (C<-A>, C<-D>, C<-U>) to pass to F<Configure>. For example,
 341
 342     -Dnoextensions=Encode
 343     -Uusedevel
 344     -Accflags=-DNO_MATHOMS
 345
 346 Repeated C<-A> arguments are passed
 347 through as is. C<-D> and C<-U> are processed in order, and override
 348 previous settings for the same parameter. F<bisect-runner.pl> emulates
 349 C<-Dnoextensions> when F<Configure> itself does not provide it, as it's
 350 often very useful to be able to disable some XS extensions.
 351
 352 =item *
 353
 354 --make I<make-prog>
 355
 356 The C<make> command to use. If this not set, F<make> is used. If this is
 357 set, it also adds a C<-Dmake=...> else some recursive make invocations
 358 in extensions may fail. Typically one would use this as C<--make gmake>
 359 to use F<gmake> in place of the system F<make>.
 360
 361 =item *
 362
 363 --jobs I<jobs>
 364
 365 =item *
 366
 367 -j I<jobs>
 368
 369 Number of C<make> jobs to run in parallel. A value of 0 suppresses
 370 parallelism. If F</proc/cpuinfo> exists and can be parsed, or F</sbin/sysctl>
 371 exists and reports C<hw.ncpu>, or F</usr/bin/getconf> exists and reports
 372 C<_NPROCESSORS_ONLN> defaults to 1 + I<number of CPUs>. On HP-UX with the
 373 system make defaults to 0, otherwise defaults to 2.
 374
 375 =item *
 376
 377 --match pattern
 378
 379 =item *
 380
 381 --no-match pattern
 382
 383 Instead of running a test program to determine I<pass> or I<fail>,
 384 C<--match> will pass if the given regex matches, and hence search for the
 385 commit that removes the last matching file. C<--no-match> inverts the test,
 386 to search for the first commit that adds files that match.
 387
 388 The remaining command line arguments are treated as glob patterns for files
 389 to match against. If none are specified, then they default as follows:
 390
 391 =over 4
 392
 393 =item *
 394
 395 If no I<target> is specified, the match is against all files in the
 396 repository (which is fast).
 397
 398 =item *
 399
 400 If a I<target> is specified, that target is built, and the match is against
 401 only the built files.
 402
 403 =back
 404
 405 Treating the command line arguments as glob patterns should not cause
 406 problems, as the perl distribution has never shipped or built files with
 407 names that contain characters which are globbing metacharacters.
 408
 409 Anything which is not a readable file is ignored, instead of generating an
 410 error. (If you want an error, run C<grep> or C<ack> as a test case). This
 411 permits one to easily search in a file that changed its name. For example:
 412
 413     .../Porting/bisect.pl --match 'Pod.*Functions' 'pod/buildtoc*'
 414
 415 C<--no-match ...> is implemented as C<--expect-fail --match ...>
 416
 417 =item *
 418
 419 --valgrind
 420
 421 Run the test program under C<valgrind>. If you need to test for memory
 422 errors when parsing invalid programs, the default parser fail exit code of
 423 255 will always override C<valgrind>, so try putting the test case invalid
 424 code inside a I<string> C<eval>, so that the perl interpreter will exit with 0.
 425 (Be sure to check the output of $@, to avoid missing mistakes such as
 426 unintended C<eval> failures due to incorrect C<@INC>)
 427
 428 Specifically, this option prepends C<valgrind> C<--error-exitcode=124> to
 429 the command line that runs the testcase, to cause valgrind to exit non-zero
 430 if it detects errors, with the assumption that the test program itself
 431 always exits with zero. If you require more flexibility than this, either
 432 specify your C<valgrind> invocation explicitly as part of the test case, or
 433 use a wrapper script to control the command line or massage the exit codes.
 434
 435 =item *
 436
 437 --test-build
 438
 439 Test that the build completes, without running any test case.
 440
 441 By default, if the build for the desired I<target> fails to complete,
 442 F<bisect-runner.pl> reports a I<skip> back to C<git bisect>, the assumption
 443 being that one wants to find a commit which changed state "builds && passes"
 444 to "builds && fails". If instead one is interested in which commit broke the
 445 build (possibly for particular F<Configure> options), use I<--test-build>
 446 to treat a build failure as a failure, not a "skip".
 447
 448 Often this option isn't as useful as it first seems, because I<any> build
 449 failure will be reported to C<git bisect> as a failure, not just the failure
 450 that you're interested in. Generally, to debug a particular problem, it's
 451 more useful to use a I<target> that builds properly at the point of interest,
 452 and then a test case that runs C<make>. For example:
 453
 454     .../Porting/bisect.pl --start=perl-5.000 --end=perl-5.002 \
 455         --expect-fail --force-manifest --target=miniperl make perl
 456
 457 will find the first revision capable of building L<DynaLoader> and then
 458 F<perl>, without becoming confused by revisions where F<miniperl> won't
 459 even link.
 460
 461 =item *
 462
 463 --force-manifest
 464
 465 By default, a build will "skip" if any files listed in F<MANIFEST> are not
 466 present. Usually this is useful, as it avoids false-failures. However, there
 467 are some long ranges of commits where listed files are missing, which can
 468 cause a bisect to abort because all that remain are skipped revisions.
 469
 470 In these cases, particularly if the test case uses F<miniperl> and no modules,
 471 it may be more useful to force the build to continue, even if files
 472 F<MANIFEST> are missing.
 473
 474 =item *
 475
 476 --force-regen
 477
 478 Run C<make regen_headers> before building F<miniperl>. This may fix a build
 479 that otherwise would skip because the generated headers at that revision
 480 are stale. It's not the default because it conceals this error in the true
 481 state of such revisions.
 482
 483 =item *
 484
 485 --expect-pass [0|1]
 486
 487 C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1> is the default.
 488
 489 =item *
 490
 491 --timeout I<seconds>
 492
 493 Run the testcase with the given timeout. If this is exceeded, kill it (and
 494 by default all its children), and treat it as a failure.
 495
 496 =item *
 497
 498 --setpgrp
 499
 500 Run the testcase in its own process group. Specifically, call C<setpgrp 0, 0>
 501 just before C<exec>-ing the user testcase. The default is not to set the
 502 process group, unless a timeout is used.
 503
 504 =item *
 505
 506 --all-fixups
 507
 508 F<bisect-runner.pl> will minimally patch various files on a platform and
 509 version dependent basis to get the build to complete. Normally it defers
 510 doing this as long as possible - C<.SH> files aren't patched until after
 511 F<Configure> is run, and C<C> and C<XS> code isn't patched until after
 512 F<miniperl> is built. If C<--all-fixups> is specified, all the fixups are
 513 done before running C<Configure>. In rare cases adding this may cause a
 514 bisect to abort, because an inapplicable patch or other fixup is attempted
 515 for a revision which would usually have already I<skip>ed. If this happens,
 516 please report it as a bug, giving the OS and problem revision.
 517
 518 =item *
 519
 520 --early-fixup file
 521
 522 =item *
 523
 524 --late-fixup file
 525
 526 Specify a file containing a patch or other fixup for the source code. The
 527 action to take depends on the first line of the fixup file
 528
 529 =over 4
 530
 531 =item *
 532
 533 C<#!perl>
 534
 535 If the first line starts C<#!perl> then the file is run using C<$^X>
 536
 537 =item *
 538
 539 C<#!/absolute/path>
 540
 541 If a shebang line is present the file is executed using C<system>
 542
 543 =item *
 544
 545 C<I<filename> =~ /I<pattern>/>
 546
 547 =item *
 548
 549 C<I<filename> !~ /I<pattern>/>
 550
 551 If I<filename> does not exist then the fixup file's contents are ignored.
 552 Otherwise, for C<=~>, if it contains a line matching I<pattern>, then the
 553 file is fed to C<patch -p1> on standard input. For C<=~>, the patch is
 554 applied if no lines match the pattern.
 555
 556 As the empty pattern in Perl is a special case (it matches the most recent
 557 sucessful match) which is not useful here, an the treatment of empty pattern
 558 is special-cased. C<I<filename> =~ //> applies the patch if filename is
 559 present. C<I<filename> !~ //> applies the patch if filename missing. This
 560 makes it easy to unconditionally apply patches to files, and to use a patch
 561 as a way of creating a new file.
 562
 563 =item *
 564
 565 Otherwise, the file is assumed to be a patch, and always applied.
 566
 567 =back
 568
 569 I<early-fixup>s are applied before F<./Configure> is run. I<late-fixup>s are
 570 applied just after F<./Configure> is run.
 571
 572 These options can be specified more than once. I<file> is actually expanded
 573 as a glob pattern. Globs that do not match are errors, as are missing files.
 574
 575 =item *
 576
 577 --no-clean
 578
 579 Tell F<bisect-runner.pl> not to clean up after the build. This allows one
 580 to use F<bisect-runner.pl> to build the current particular perl revision for
 581 interactive testing, or for debugging F<bisect-runner.pl>.
 582
 583 Passing this to F<bisect.pl> will likely cause the bisect to fail badly.
 584
 585 =item *
 586
 587 --validate
 588
 589 Test that all stable (.0) revisions can be built. By default, attempts to
 590 build I<blead>, then tagged stable releases in reverse order down to
 591 I<perl-5.002> (or I<perl5.005> on a case insensitive file system). Stops at
 592 the first failure, without cleaning the checkout. Use I<--start> to specify
 593 the earliest revision to test, I<--end> to specify the most recent. Useful
 594 for validating a new OS/CPU/compiler combination. For example
 595
 596     ../perl/Porting/bisect.pl --validate -le 'print "Hello from $]"'
 597
 598 If no testcase is specified, the default is to use F<t/TEST> to run
 599 F<t/base/*.t>
 600
 601 =item *
 602
 603 --check-args
 604
 605 Validate the options and arguments, and exit silently if they are valid.
 606
 607 =item *
 608
 609 --check-shebang
 610
 611 Validate that the test case isn't an executable file with a
 612 C<#!/usr/bin/perl> line (or similar). As F<bisect-runner.pl> does B<not>
 613 automatically prepend C<./perl> to the test case, a I<#!> line specifying an
 614 external F<perl> binary will cause the test case to always run with I<that>
 615 F<perl>, not the F<perl> built by the bisect runner. Likely this is not what
 616 you wanted. If your test case is actually a wrapper script to run other
 617 commands, you should run it with an explicit interpreter, to be clear. For
 618 example, instead of C<../perl/Porting/bisect.pl ~/test/testcase.pl> you'd
 619 run C<../perl/Porting/bisect.pl /usr/bin/perl ~/test/testcase.pl>
 620
 621 =item *
 622
 623 --gold
 624
 625 Revision to use when checking out known-good recent versions of files,
 626 such as F<makedepend.SH>. F<bisect-runner.pl> defaults this to I<blead>,
 627 but F<bisect.pl> will default it to the most recent stable release.
 628
 629 =item *
 630
 631 --usage
 632
 633 =item *
 634
 635 --help
 636
 637 =item *
 638
 639 -?
 640
 641 Display the usage information and exit.
 642
 643 =back
 644
 645 =cut
 646
 647 # Ensure we always exit with 255, to cause git bisect to abort.
 648 sub croak_255 {
 649     my $message = join '', @_;
 650     if ($message =~ /\n\z/) {
 651         print STDERR $message;
 652     } else {
 653         my (undef, $file, $line) = caller 1;
 654         print STDERR "@_ at $file line $line\n";
 655     }
 656     exit 255;
 657 }
 658
 659 sub die_255 {
 660     croak_255(@_);
 661 }
 662
 663 die_255("$0: Can't build $target")
 664     if defined $target && !grep {@targets} $target;
 665
 666 foreach my $phase (qw(early late)) {
 667     next unless $options{"$phase-fixup"};
 668     my $bail_out;
 669     require File::Glob;
 670     my @expanded;
 671     foreach my $glob (@{$options{"$phase-fixup"}}) {
 672         my @got = File::Glob::bsd_glob($glob);
 673         push @expanded, @got ? @got : $glob;
 674     }
 675     @expanded = sort @expanded;
 676     $options{"$phase-fixup"} = \@expanded;
 677     foreach (@expanded) {
 678         unless (-f $_) {
 679             print STDERR "$phase-fixup '$_' is not a readable file\n";
 680             ++$bail_out;
 681         }
 682     }
 683     exit 255 if $bail_out;
 684 }
 685
 686 unless (exists $defines{cc}) {
 687     # If it fails, the heuristic of 63f9ec3008baf7d6 is noisy, and hence
 688     # confusing.
 689     # FIXME - really it should be replaced with a proper test of
 690     # "can we build something?" and a helpful diagnostic if we can't.
 691     # For now, simply move it here.
 692     $defines{cc} = (`ccache -V`, $?) ? 'cc' : 'ccache cc';
 693 }
 694
 695 my $j = $options{jobs} ? "-j$options{jobs}" : '';
 696
 697 if (exists $options{make}) {
 698     if (!exists $defines{make}) {
 699         $defines{make} = $options{make};
 700     }
 701 } else {
 702     $options{make} = 'make';
 703 }
 704
 705 # Sadly, however hard we try, I don't think that it will be possible to build
 706 # modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29,
 707 # which updated to MakeMaker 3.7, which changed from using a hard coded ld
 708 # in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc.
 709
 710 sub open_or_die {
 711     my $file = shift;
 712     my $mode = @_ ? shift : '<';
 713     open my $fh, $mode, $file or croak_255("Can't open $file: $!");
 714     ${*$fh{SCALAR}} = $file;
 715     return $fh;
 716 }
 717
 718 sub close_or_die {
 719     my $fh = shift;
 720     return if close $fh;
 721     croak_255("Can't close: $!") unless ref $fh eq 'GLOB';
 722     croak_255("Can't close ${*$fh{SCALAR}}: $!");
 723 }
 724
 725 sub system_or_die {
 726     my $command = '</dev/null ' . shift;
 727     system($command) and croak_255("'$command' failed, \$!=$!, \$?=$?");
 728 }
 729
 730 sub run_with_options {
 731     my $options = shift;
 732     my $name = $options->{name};
 733     $name = "@_" unless defined $name;
 734
 735     my $setgrp = $options->{setpgrp};
 736     if ($options->{timeout}) {
 737         # Unless you explicitly disabled it on the commandline, set it:
 738         $setgrp = 1 unless defined $setgrp;
 739     }
 740     my $pid = fork;
 741     die_255("Can't fork: $!") unless defined $pid;
 742     if (!$pid) {
 743         if (exists $options->{stdin}) {
 744             open STDIN, '<', $options->{stdin}
 745               or die "Can't open STDIN from $options->{stdin}: $!";
 746         }
 747         if ($setgrp) {
 748             setpgrp 0, 0
 749                 or die "Can't setpgrp 0, 0: $!";
 750         }
 751         { exec @_ };
 752         die_255("Failed to start $name: $!");
 753     }
 754     my $start;
 755     if ($options->{timeout}) {
 756         require Errno;
 757         require POSIX;
 758         die_255("No POSIX::WNOHANG")
 759             unless &POSIX::WNOHANG;
 760         $start = time;
 761         $SIG{ALRM} = sub {
 762             my $victim = $setgrp ? -$pid : $pid;
 763             my $delay = 1;
 764             kill 'TERM', $victim;
 765             waitpid(-1, &POSIX::WNOHANG);
 766             while (kill 0, $victim) {
 767                 sleep $delay;
 768                 waitpid(-1, &POSIX::WNOHANG);
 769                 $delay *= 2;
 770                 if ($delay > 8) {
 771                     if (kill 'KILL', $victim) {
 772                         print STDERR "$0: Had to kill 'KILL', $victim\n"
 773                     } elsif (! $!{ESRCH}) {
 774                         print STDERR "$0: kill 'KILL', $victim failed: $!\n";
 775                     }
 776                     last;
 777                 }
 778             }
 779             report_and_exit(0, 'No timeout', 'Timeout', "when running $name");
 780         };
 781         alarm $options->{timeout};
 782     }
 783     waitpid $pid, 0
 784       or die_255("wait for $name, pid $pid failed: $!");
 785     alarm 0;
 786     if ($options->{timeout}) {
 787         my $elapsed = time - $start;
 788         if ($elapsed / $options->{timeout} > 0.8) {
 789             print STDERR "$0: Beware, took $elapsed seconds of $options->{timeout} permitted to run $name\n";
 790         }
 791     }
 792     return $?;
 793 }
 794
 795 sub extract_from_file {
 796     my ($file, $rx, $default) = @_;
 797     my $fh = open_or_die($file);
 798     while (<$fh>) {
 799         my @got = $_ =~ $rx;
 800         return wantarray ? @got : $got[0]
 801             if @got;
 802     }
 803     return $default if defined $default;
 804     return;
 805 }
 806
 807 sub edit_file {
 808     my ($file, $munger) = @_;
 809     local $/;
 810     my $fh = open_or_die($file);
 811     my $orig = <$fh>;
 812     die_255("Can't read $file: $!") unless defined $orig && close $fh;
 813     my $new = $munger->($orig);
 814     return if $new eq $orig;
 815     $fh = open_or_die($file, '>');
 816     print $fh $new or die_255("Can't print to $file: $!");
 817     close_or_die($fh);
 818 }
 819
 820 # AIX supplies a pre-historic patch program, which certainly predates Linux
 821 # and is probably older than NT. It can't cope with unified diffs. Meanwhile,
 822 # it's hard enough to get git diff to output context diffs, let alone git show,
 823 # and nearly all the patches embedded here are unified. So it seems that the
 824 # path of least resistance is to convert unified diffs to context diffs:
 825
 826 sub process_hunk {
 827     my ($from_out, $to_out, $has_from, $has_to, $delete, $add) = @_;
 828     ++$$has_from if $delete;
 829     ++$$has_to if $add;
 830
 831     if ($delete && $add) {
 832         $$from_out .= "! $_\n" foreach @$delete;
 833         $$to_out .= "! $_\n" foreach @$add;
 834     } elsif ($delete) {
 835         $$from_out .= "- $_\n" foreach @$delete;
 836     } elsif ($add) {
 837          $$to_out .= "+ $_\n" foreach @$add;
 838     }
 839 }
 840
 841 # This isn't quite general purpose, as it can't cope with
 842 # '\ No newline at end of file'
 843 sub ud2cd {
 844     my $diff_in = shift;
 845     my $diff_out = '';
 846
 847     # Stuff before the diff
 848     while ($diff_in =~ s/\A(?!\*\*\* )(?!--- )([^\n]*\n?)//ms && length $1) {
 849         $diff_out .= $1;
 850     }
 851
 852     if (!length $diff_in) {
 853         die_255("That didn't seem to be a diff");
 854     }
 855
 856     if ($diff_in =~ /\A\*\*\* /ms) {
 857         warn "Seems to be a context diff already\n";
 858         return $diff_out . $diff_in;
 859     }
 860
 861     # Loop for files
 862  FILE: while (1) {
 863         if ($diff_in =~ s/\A((?:diff |index )[^\n]+\n)//ms) {
 864             $diff_out .= $1;
 865             next;
 866         }
 867         if ($diff_in !~ /\A--- /ms) {
 868             # Stuff after the diff;
 869             return $diff_out . $diff_in;
 870         }
 871         $diff_in =~ s/\A([^\n]+\n?)//ms;
 872         my $line = $1;
 873         die_255("Can't parse '$line'") unless $line =~ s/\A--- /*** /ms;
 874         $diff_out .= $line;
 875         $diff_in =~ s/\A([^\n]+\n?)//ms;
 876         $line = $1;
 877         die_255("Can't parse '$line'") unless $line =~ s/\A\+\+\+ /--- /ms;
 878         $diff_out .= $line;
 879
 880         # Loop for hunks
 881         while (1) {
 882             next FILE
 883                 unless $diff_in =~ s/\A\@\@ (-([0-9]+),([0-9]+) \+([0-9]+),([0-9]+)) \@\@[^\n]*\n?//;
 884             my ($hunk, $from_start, $from_count, $to_start, $to_count)
 885                 = ($1, $2, $3, $4, $5);
 886             my $from_end = $from_start + $from_count - 1;
 887             my $to_end = $to_start + $to_count - 1;
 888             my ($from_out, $to_out, $has_from, $has_to, $add, $delete);
 889             while (length $diff_in && ($from_count || $to_count)) {
 890                 die_255("Confused in $hunk")
 891                     unless $diff_in =~ s/\A([^\n]*)\n//ms;
 892                 my $line = $1;
 893                 $line = ' ' unless length $line;
 894                 if ($line =~ /^ .*/) {
 895                     process_hunk(\$from_out, \$to_out, \$has_from, \$has_to,
 896                                  $delete, $add);
 897                     undef $delete;
 898                     undef $add;
 899                     $from_out .= " $line\n";
 900                     $to_out .= " $line\n";
 901                     --$from_count;
 902                     --$to_count;
 903                 } elsif ($line =~ /^-(.*)/) {
 904                     push @$delete, $1;
 905                     --$from_count;
 906                 } elsif ($line =~ /^\+(.*)/) {
 907                     push @$add, $1;
 908                     --$to_count;
 909                 } else {
 910                     die_255("Can't parse '$line' as part of hunk $hunk");
 911                 }
 912             }
 913             process_hunk(\$from_out, \$to_out, \$has_from, \$has_to,
 914                          $delete, $add);
 915             die_255("No lines in hunk $hunk")
 916                 unless length $from_out || length $to_out;
 917             die_255("No changes in hunk $hunk")
 918                 unless $has_from || $has_to;
 919             $diff_out .= "***************\n";
 920             $diff_out .= "*** $from_start,$from_end ****\n";
 921             $diff_out .= $from_out if $has_from;
 922             $diff_out .= "--- $to_start,$to_end ----\n";
 923             $diff_out .= $to_out if $has_to;
 924         }
 925     }
 926 }
 927
 928 {
 929     my $use_context;
 930
 931     sub placate_patch_prog {
 932         my $patch = shift;
 933
 934         if (!defined $use_context) {
 935             my $version = `patch -v 2>&1`;
 936             die_255("Can't run `patch -v`, \$?=$?, bailing out")
 937                 unless defined $version;
 938             if ($version =~ /Free Software Foundation/) {
 939                 $use_context = 0;
 940             } elsif ($version =~ /Header: patch\.c,v.*\blwall\b/) {
 941                 # The system patch is older than Linux, and probably older than
 942                 # Windows NT.
 943                 $use_context = 1;
 944             } elsif ($version =~ /Header: patch\.c,v.*\babhinav\b/) {
 945                 # Thank you HP. No, we have no idea *which* version this is:
 946                 # $Header: patch.c,v 76.1.1.2.1.3 2001/12/03 12:24:52 abhinav Exp $
 947                 $use_context = 1;
 948             } else {
 949                 # Don't know.
 950                 $use_context = 0;
 951             }
 952         }
 953
 954         return $use_context ? ud2cd($patch) : $patch;
 955     }
 956 }
 957
 958 sub apply_patch {
 959     my ($patch, $what, $files) = @_;
 960     $what = 'patch' unless defined $what;
 961     unless (defined $files) {
 962         $patch =~ m!^--- a/(\S+)\n\+\+\+ b/\1!sm;
 963         $files = " $1";
 964     }
 965     my $patch_to_use = placate_patch_prog($patch);
 966     open my $fh, '|-', 'patch', '-p1' or die_255("Can't run patch: $!");
 967     print $fh $patch_to_use;
 968     return if close $fh;
 969     print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n";
 970     print STDERR "\nConverted to a context diff <<'EOCONTEXT'\n${patch_to_use}EOCONTEXT\n"
 971         if $patch_to_use ne $patch;
 972     die_255("Can't $what$files: $?, $!");
 973 }
 974
 975 sub apply_commit {
 976     my ($commit, @files) = @_;
 977     my $patch = `git show $commit @files`;
 978     if (!defined $patch) {
 979         die_255("Can't get commit $commit for @files: $?") if @files;
 980         die_255("Can't get commit $commit: $?");
 981     }
 982     apply_patch($patch, "patch $commit", @files ? " for @files" : '');
 983 }
 984
 985 sub revert_commit {
 986     my ($commit, @files) = @_;
 987     my $patch = `git show -R $commit @files`;
 988     if (!defined $patch) {
 989         die_255("Can't get revert commit $commit for @files: $?") if @files;
 990         die_255("Can't get revert commit $commit: $?");
 991     }
 992     apply_patch($patch, "revert $commit", @files ? " for @files" : '');
 993 }
 994
 995 sub checkout_file {
 996     my ($file, $commit) = @_;
 997     $commit ||= $options{gold} || 'blead';
 998     system "git show $commit:$file > $file </dev/null"
 999         and die_255("Could not extract $file at revision $commit");
1000 }
1001
1002 sub check_shebang {
1003     my $file = shift;
1004     return unless -e $file;
1005     my $fh = open_or_die($file);
1006     my $line = <$fh>;
1007     return if $line =~ $run_with_our_perl;
1008     if (!-x $file) {
1009         die_255("$file is not executable.
1010 system($file, ...) is always going to fail.
1011
1012 Bailing out");
1013     }
1014     return unless $line =~ m{\A#!(/\S+/perl\S*)\s};
1015     die_255("$file will always be run by $1
1016 It won't be tested by the ./perl we build.
1017 If you intended to run it with that perl binary, please change your
1018 test case to
1019
1020     $1 @ARGV
1021
1022 If you intended to test it with the ./perl we build, please change your
1023 test case to
1024
1025     ./perl -Ilib @ARGV
1026
1027 [You may also need to add -- before ./perl to prevent that -Ilib as being
1028 parsed as an argument to bisect.pl]
1029
1030 Bailing out");
1031 }
1032
1033 sub clean {
1034     if ($options{clean}) {
1035         # Needed, because files that are build products in this checked out
1036         # version might be in git in the next desired version.
1037         system 'git clean -dxf </dev/null';
1038         # Needed, because at some revisions the build alters checked out files.
1039         # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
1040         system 'git reset --hard HEAD </dev/null';
1041     }
1042 }
1043
1044 sub skip {
1045     my $reason = shift;
1046     clean();
1047     warn "skipping - $reason";
1048     exit 125;
1049 }
1050
1051 sub report_and_exit {
1052     my ($good, $pass, $fail, $desc) = @_;
1053
1054     clean();
1055
1056     my $got = ($options{'expect-pass'} ? $good : !$good) ? 'good' : 'bad';
1057     if ($good) {
1058         print "$got - $pass $desc\n";
1059     } else {
1060         print "$got - $fail $desc\n";
1061     }
1062
1063     exit($got eq 'bad');
1064 }
1065
1066 sub run_report_and_exit {
1067     my $ret = run_with_options({setprgp => $options{setpgrp},
1068                                 timeout => $options{timeout},
1069                                }, @_);
1070     report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_");
1071 }
1072
1073 sub match_and_exit {
1074     my ($target, @globs) = @_;
1075     my $matches = 0;
1076     my $re = qr/$match/;
1077     my @files;
1078
1079     if (@globs) {
1080         require File::Glob;
1081         foreach (sort map { File::Glob::bsd_glob($_)} @globs) {
1082             if (!-f $_ || !-r _) {
1083                 warn "Skipping matching '$_' as it is not a readable file\n";
1084             } else {
1085                 push @files, $_;
1086             }
1087         }
1088     } else {
1089         local $/ = "\0";
1090         @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`;
1091         chomp @files;
1092     }
1093
1094     foreach my $file (@files) {
1095         my $fh = open_or_die($file);
1096         while (<$fh>) {
1097             if ($_ =~ $re) {
1098                 ++$matches;
1099                 if (tr/\t\r\n -~\200-\377//c) {
1100                     print "Binary file $file matches\n";
1101                 } else {
1102                     $_ .= "\n" unless /\n\z/;
1103                     print "$file: $_";
1104                 }
1105             }
1106         }
1107         close_or_die($fh);
1108     }
1109     report_and_exit($matches,
1110                     $matches == 1 ? '1 match for' : "$matches matches for",
1111                     'no matches for', $match);
1112 }
1113
1114 # Not going to assume that system perl is yet new enough to have autodie
1115 system_or_die('git clean -dxf');
1116
1117 if (!defined $target) {
1118     match_and_exit(undef, @ARGV) if $match;
1119     $target = 'test_prep';
1120 }
1121
1122 skip('no Configure - is this the //depot/perlext/Compiler branch?')
1123     unless -f 'Configure';
1124
1125 my $case_insensitive;
1126 {
1127     my ($dev_C, $ino_C) = stat 'Configure';
1128     die_255("Could not stat Configure: $!") unless defined $dev_C;
1129     my ($dev_c, $ino_c) = stat 'configure';
1130     ++$case_insensitive
1131         if defined $dev_c && $dev_C == $dev_c && $ino_C == $ino_c;
1132 }
1133
1134 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
1135 my $major
1136     = extract_from_file('patchlevel.h',
1137                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
1138                         0);
1139
1140 my $unfixable_db_file;
1141
1142 if ($major < 10
1143     && !extract_from_file('ext/DB_File/DB_File.xs',
1144                           qr!^#else /\* Berkeley DB Version > 2 \*/$!)) {
1145     # This DB_File.xs is really too old to patch up.
1146     # Skip DB_File, unless we're invoked with an explicit -Unoextensions
1147     if (!exists $defines{noextensions}) {
1148         $defines{noextensions} = 'DB_File';
1149     } elsif (defined $defines{noextensions}) {
1150         $defines{noextensions} .= ' DB_File';
1151     }
1152     ++$unfixable_db_file;
1153 }
1154
1155 patch_Configure();
1156 patch_hints();
1157 if ($options{'all-fixups'}) {
1158     patch_SH();
1159     patch_C();
1160     patch_ext();
1161 }
1162 apply_fixups($options{'early-fixup'});
1163
1164 # if Encode is not needed for the test, you can speed up the bisect by
1165 # excluding it from the runs with -Dnoextensions=Encode
1166 # ccache is an easy win. Remove it if it causes problems.
1167 # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
1168 # to true in hints/linux.sh
1169 # On dromedary, from that point on, Configure (by default) fails to find any
1170 # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
1171 # versioned libraries. Without -lm, the build fails.
1172 # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
1173 # until commit faae14e6e968e1c0 adds it to the hints.
1174 # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
1175 # because it will spot versioned libraries, pass them to the compiler, and then
1176 # bail out pretty early on. Configure won't let us override libswanted, but it
1177 # will let us override the entire libs list.
1178
1179 foreach (@{$options{A}}) {
1180     push @paths, $1 if /^libpth=(.*)/s;
1181 }
1182
1183 unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
1184     # Before 1cfa4ec74d4933da, so force the libs list.
1185
1186     my @libs;
1187     # This is the current libswanted list from Configure, less the libs removed
1188     # by current hints/linux.sh
1189     foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
1190                         ld sun m crypt sec util c cposix posix ucb BSD)) {
1191         foreach my $dir (@paths) {
1192             # Note the wonderful consistency of dot-or-not in the config vars:
1193             next unless -f "$dir/lib$lib.$Config{dlext}"
1194                 || -f "$dir/lib$lib$Config{lib_ext}";
1195             push @libs, "-l$lib";
1196             last;
1197         }
1198     }
1199     $defines{libs} = \@libs unless exists $defines{libs};
1200 }
1201
1202 $defines{usenm} = undef
1203     if $major < 2 && !exists $defines{usenm};
1204
1205 my ($missing, $created_dirs);
1206 ($missing, $created_dirs) = force_manifest()
1207     if $options{'force-manifest'};
1208
1209 my @ARGS = '-dEs';
1210 foreach my $key (sort keys %defines) {
1211     my $val = $defines{$key};
1212     if (ref $val) {
1213         push @ARGS, "-D$key=@$val";
1214     } elsif (!defined $val) {
1215         push @ARGS, "-U$key";
1216     } elsif (!length $val) {
1217         push @ARGS, "-D$key";
1218     } else {
1219         $val = "" if $val eq "\0";
1220         push @ARGS, "-D$key=$val";
1221     }
1222 }
1223 push @ARGS, map {"-A$_"} @{$options{A}};
1224
1225 # If a file in MANIFEST is missing, Configure asks if you want to
1226 # continue (the default being 'n'). With stdin closed or /dev/null,
1227 # it exits immediately and the check for config.sh below will skip.
1228 # Without redirecting stdin, the commands called will attempt to read from
1229 # stdin (and thus effectively hang)
1230 run_with_options({stdin => '/dev/null', name => 'Configure'},
1231                  './Configure', @ARGS);
1232
1233 patch_SH() unless $options{'all-fixups'};
1234 apply_fixups($options{'late-fixup'});
1235
1236 if (-f 'config.sh') {
1237     # Emulate noextensions if Configure doesn't support it.
1238     fake_noextensions()
1239         if $major < 10 && $defines{noextensions};
1240     system_or_die('./Configure -S');
1241 }
1242
1243 if ($target =~ /config\.s?h/) {
1244     match_and_exit($target, @ARGV) if $match && -f $target;
1245     report_and_exit(-f $target, 'could build', 'could not build', $target)
1246         if $options{'test-build'};
1247
1248     skip("could not build $target") unless -f $target;
1249
1250     run_report_and_exit(@ARGV);
1251 } elsif (!-f 'config.sh') {
1252     # Skip if something went wrong with Configure
1253
1254     skip('could not build config.sh');
1255 }
1256
1257 force_manifest_cleanup($missing, $created_dirs)
1258         if $missing;
1259
1260 if($options{'force-regen'}
1261    && extract_from_file('Makefile', qr/\bregen_headers\b/)) {
1262     # regen_headers was added in e50aee73b3d4c555, patch.1m for perl5.001
1263     # It's not worth faking it for earlier revisions.
1264     system_or_die('make regen_headers');
1265 }
1266
1267 unless ($options{'all-fixups'}) {
1268     patch_C();
1269     patch_ext();
1270 }
1271
1272 # Parallel build for miniperl is safe
1273 system "$options{make} $j miniperl </dev/null";
1274
1275 # This is the file we expect make to create
1276 my $expected_file = $target =~ /^test/ ? 't/perl'
1277     : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}"
1278     : $target;
1279 # This is the target we tell make to build in order to get $expected_file
1280 my $real_target = $target eq 'Fcntl' ? $expected_file : $target;
1281
1282 if ($target ne 'miniperl') {
1283     # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
1284     $j = '' if $major < 10;
1285
1286     if ($real_target eq 'test_prep') {
1287         if ($major < 8) {
1288             # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
1289             # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
1290             # earlier than that, just make test. It will be fast enough.
1291             $real_target = extract_from_file('Makefile.SH',
1292                                              qr/^(test[-_]prep):/,
1293                                              'test');
1294         }
1295     }
1296
1297     system "$options{make} $j $real_target </dev/null";
1298 }
1299
1300 my $expected_file_found = $expected_file =~ /perl$/
1301     ? -x $expected_file : -r $expected_file;
1302
1303 if ($expected_file_found && $expected_file eq 't/perl') {
1304     # Check that it isn't actually pointing to ../miniperl, which will happen
1305     # if the sanity check ./miniperl -Ilib -MExporter -e '<?>' fails, and
1306     # Makefile tries to run minitest.
1307
1308     # Of course, helpfully sometimes it's called ../perl, other times .././perl
1309     # and who knows if that list is exhaustive...
1310     my ($dev0, $ino0) = stat 't/perl';
1311     my ($dev1, $ino1) = stat 'perl';
1312     unless (defined $dev0 && defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1) {
1313         undef $expected_file_found;
1314         my $link = readlink $expected_file;
1315         warn "'t/perl' => '$link', not 'perl'";
1316         die_255("Could not realink t/perl: $!") unless defined $link;
1317     }
1318 }
1319
1320 if ($options{'test-build'}) {
1321     report_and_exit($expected_file_found, 'could build', 'could not build',
1322                     $real_target);
1323 } elsif (!$expected_file_found) {
1324     skip("could not build $real_target");
1325 }
1326
1327 match_and_exit($real_target, @ARGV) if $match;
1328
1329 if (defined $options{'one-liner'}) {
1330     my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl';
1331     unshift @ARGV, '-e', $options{'one-liner'};
1332     foreach (qw(c l w)) {
1333         unshift @ARGV, "-$_" if $options{$_};
1334     }
1335     unshift @ARGV, "./$exe", '-Ilib';
1336 }
1337
1338 if (-f $ARGV[0]) {
1339     my $fh = open_or_die($ARGV[0]);
1340     my $line = <$fh>;
1341     unshift @ARGV, $1, '-Ilib'
1342         if $line =~ $run_with_our_perl;
1343 }
1344
1345 if ($options{valgrind}) {
1346     # Turns out to be too confusing to use an optional argument with the path
1347     # of the valgrind binary, as if --valgrind takes an optional argument,
1348     # then specifying it as the last option eats the first part of the testcase.
1349     # ie this: .../bisect.pl --valgrind testcase
1350     # is treated as --valgrind=testcase and as there is no test case given,
1351     # it's an invalid commandline, bailing out with the usage message.
1352
1353     # Currently, the test script can't signal a skip with 125, so anything
1354     # non-zero would do. But to keep that option open in future, use 124
1355     unshift @ARGV, 'valgrind', '--error-exitcode=124';
1356 }
1357
1358 # This is what we came here to run:
1359
1360 if (exists $Config{ldlibpthname}) {
1361     require Cwd;
1362     my $varname = $Config{ldlibpthname};
1363     my $cwd = Cwd::getcwd();
1364     if (defined $ENV{$varname}) {
1365         $ENV{$varname} = $cwd . $Config{path_sep} . $ENV{$varname};
1366     } else {
1367         $ENV{$varname} = $cwd;
1368     }
1369 }
1370
1371 run_report_and_exit(@ARGV);
1372
1373 ############################################################################
1374 #
1375 # Patching, editing and faking routines only below here.
1376 #
1377 ############################################################################
1378
1379 sub fake_noextensions {
1380     edit_file('config.sh', sub {
1381                   my @lines = split /\n/, shift;
1382                   my @ext = split /\s+/, $defines{noextensions};
1383                   foreach (@lines) {
1384                       next unless /^extensions=/ || /^dynamic_ext/;
1385                       foreach my $ext (@ext) {
1386                           s/\b$ext( )?\b/$1/;
1387                       }
1388                   }
1389                   return join "\n", @lines;
1390               });
1391 }
1392
1393 sub force_manifest {
1394     my (@missing, @created_dirs);
1395     my $fh = open_or_die('MANIFEST');
1396     while (<$fh>) {
1397         next unless /^(\S+)/;
1398         # -d is special case needed (at least) between 27332437a2ed1941 and
1399         # bf3d9ec563d25054^ inclusive, as manifest contains ext/Thread/Thread
1400         push @missing, $1
1401             unless -f $1 || -d $1;
1402     }
1403     close_or_die($fh);
1404
1405     foreach my $pathname (@missing) {
1406         my @parts = split '/', $pathname;
1407         my $leaf = pop @parts;
1408         my $path = '.';
1409         while (@parts) {
1410             $path .= '/' . shift @parts;
1411             next if -d $path;
1412             mkdir $path, 0700 or die_255("Can't create $path: $!");
1413             unshift @created_dirs, $path;
1414         }
1415         $fh = open_or_die($pathname, '>');
1416         close_or_die($fh);
1417         chmod 0, $pathname or die_255("Can't chmod 0 $pathname: $!");
1418     }
1419     return \@missing, \@created_dirs;
1420 }
1421
1422 sub force_manifest_cleanup {
1423     my ($missing, $created_dirs) = @_;
1424     # This is probably way too paranoid:
1425     my @errors;
1426     require Fcntl;
1427     foreach my $file (@$missing) {
1428         my (undef, undef, $mode, undef, undef, undef, undef, $size)
1429             = stat $file;
1430         if (!defined $mode) {
1431             push @errors, "Added file $file has been deleted by Configure";
1432             next;
1433         }
1434         if (Fcntl::S_IMODE($mode) != 0) {
1435             push @errors,
1436                 sprintf 'Added file %s had mode changed by Configure to %03o',
1437                     $file, $mode;
1438         }
1439         if ($size != 0) {
1440             push @errors,
1441                 "Added file $file had sized changed by Configure to $size";
1442         }
1443         unlink $file or die_255("Can't unlink $file: $!");
1444     }
1445     foreach my $dir (@$created_dirs) {
1446         rmdir $dir or die_255("Can't rmdir $dir: $!");
1447     }
1448     skip("@errors")
1449         if @errors;
1450 }
1451
1452 sub patch_Configure {
1453     if ($major < 1) {
1454         if (extract_from_file('Configure',
1455                               qr/^\t\t\*=\*\) echo "\$1" >> \$optdef;;$/)) {
1456             # This is "        Spaces now allowed in -D command line options.",
1457             # part of commit ecfc54246c2a6f42
1458             apply_patch(<<'EOPATCH');
1459 diff --git a/Configure b/Configure
1460 index 3d3b38d..78ffe16 100755
1461 --- a/Configure
1462 +++ b/Configure
1463 @@ -652,7 +777,8 @@ while test $# -gt 0; do
1464                         echo "$me: use '-U symbol=', not '-D symbol='." >&2
1465                         echo "$me: ignoring -D $1" >&2
1466                         ;;
1467 -               *=*) echo "$1" >> $optdef;;
1468 +               *=*) echo "$1" | \
1469 +                               sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;;
1470                 *) echo "$1='define'" >> $optdef;;
1471                 esac
1472                 shift
1473 EOPATCH
1474         }
1475
1476         if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) {
1477             # Configure's original simple "grep" for d_namlen falls foul of the
1478             # approach taken by the glibc headers:
1479             # #ifdef _DIRENT_HAVE_D_NAMLEN
1480             # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen)
1481             #
1482             # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux.
1483             # This is also part of commit ecfc54246c2a6f42
1484             apply_patch(<<'EOPATCH');
1485 diff --git a/Configure b/Configure
1486 index 3d3b38d..78ffe16 100755
1487 --- a/Configure
1488 +++ b/Configure
1489 @@ -3935,7 +4045,8 @@ $rm -f try.c
1490
1491  : see if the directory entry stores field length
1492  echo " "
1493 -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
1494 +$cppstdin $cppflags $cppminus < "$xinc" > try.c
1495 +if $contains 'd_namlen' try.c >/dev/null 2>&1; then
1496         echo "Good, your directory entry keeps length information in d_namlen." >&4
1497         val="$define"
1498  else
1499 EOPATCH
1500         }
1501     }
1502
1503     if ($major < 2
1504         && !extract_from_file('Configure',
1505                               qr/Try to guess additional flags to pick up local libraries/)) {
1506         my $mips = extract_from_file('Configure',
1507                                      qr!(''\) if (?:\./)?mips; then)!);
1508         # This is part of perl-5.001n. It's needed, to add -L/usr/local/lib to
1509         # the ld flags if libraries are found there. It shifts the code to set
1510         # up libpth earlier, and then adds the code to add libpth entries to
1511         # ldflags
1512         # mips was changed to ./mips in ecfc54246c2a6f42, perl5.000 patch.0g
1513         apply_patch(sprintf <<'EOPATCH', $mips);
1514 diff --git a/Configure b/Configure
1515 index 53649d5..0635a6e 100755
1516 --- a/Configure
1517 +++ b/Configure
1518 @@ -2749,6 +2749,52 @@ EOM
1519         ;;
1520  esac
1521
1522 +: Set private lib path
1523 +case "$plibpth" in
1524 +'') if ./mips; then
1525 +               plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
1526 +       fi;;
1527 +esac
1528 +case "$libpth" in
1529 +' ') dlist='';;
1530 +'') dlist="$plibpth $glibpth";;
1531 +*) dlist="$libpth";;
1532 +esac
1533 +
1534 +: Now check and see which directories actually exist, avoiding duplicates
1535 +libpth=''
1536 +for xxx in $dlist
1537 +do
1538 +    if $test -d $xxx; then
1539 +               case " $libpth " in
1540 +               *" $xxx "*) ;;
1541 +               *) libpth="$libpth $xxx";;
1542 +               esac
1543 +    fi
1544 +done
1545 +$cat <<'EOM'
1546 +
1547 +Some systems have incompatible or broken versions of libraries.  Among
1548 +the directories listed in the question below, please remove any you
1549 +know not to be holding relevant libraries, and add any that are needed.
1550 +Say "none" for none.
1551 +
1552 +EOM
1553 +case "$libpth" in
1554 +'') dflt='none';;
1555 +*)
1556 +       set X $libpth
1557 +       shift
1558 +       dflt=${1+"$@"}
1559 +       ;;
1560 +esac
1561 +rp="Directories to use for library searches?"
1562 +. ./myread
1563 +case "$ans" in
1564 +none) libpth=' ';;
1565 +*) libpth="$ans";;
1566 +esac
1567 +
1568  : flags used in final linking phase
1569  case "$ldflags" in
1570  '') if ./venix; then
1571 @@ -2765,6 +2811,23 @@ case "$ldflags" in
1572         ;;
1573  *) dflt="$ldflags";;
1574  esac
1575 +
1576 +: Possible local library directories to search.
1577 +loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib"
1578 +loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib"
1579 +
1580 +: Try to guess additional flags to pick up local libraries.
1581 +for thislibdir in $libpth; do
1582 +       case " $loclibpth " in
1583 +       *" $thislibdir "*)
1584 +               case "$dflt " in
1585 +               "-L$thislibdir ") ;;
1586 +               *)  dflt="$dflt -L$thislibdir" ;;
1587 +               esac
1588 +               ;;
1589 +       esac
1590 +done
1591 +
1592  echo " "
1593  rp="Any additional ld flags (NOT including libraries)?"
1594  . ./myread
1595 @@ -2828,52 +2891,6 @@ n) echo "OK, that should do.";;
1596  esac
1597  $rm -f try try.* core
1598
1599 -: Set private lib path
1600 -case "$plibpth" in
1601 -%s
1602 -               plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
1603 -       fi;;
1604 -esac
1605 -case "$libpth" in
1606 -' ') dlist='';;
1607 -'') dlist="$plibpth $glibpth";;
1608 -*) dlist="$libpth";;
1609 -esac
1610 -
1611 -: Now check and see which directories actually exist, avoiding duplicates
1612 -libpth=''
1613 -for xxx in $dlist
1614 -do
1615 -    if $test -d $xxx; then
1616 -               case " $libpth " in
1617 -               *" $xxx "*) ;;
1618 -               *) libpth="$libpth $xxx";;
1619 -               esac
1620 -    fi
1621 -done
1622 -$cat <<'EOM'
1623 -
1624 -Some systems have incompatible or broken versions of libraries.  Among
1625 -the directories listed in the question below, please remove any you
1626 -know not to be holding relevant libraries, and add any that are needed.
1627 -Say "none" for none.
1628 -
1629 -EOM
1630 -case "$libpth" in
1631 -'') dflt='none';;
1632 -*)
1633 -       set X $libpth
1634 -       shift
1635 -       dflt=${1+"$@"}
1636 -       ;;
1637 -esac
1638 -rp="Directories to use for library searches?"
1639 -. ./myread
1640 -case "$ans" in
1641 -none) libpth=' ';;
1642 -*) libpth="$ans";;
1643 -esac
1644 -
1645  : compute shared library extension
1646  case "$so" in
1647  '')
1648 EOPATCH
1649     }
1650
1651     if ($major < 5 && extract_from_file('Configure',
1652                                         qr!if \$cc \$ccflags try\.c -o try >/dev/null 2>&1; then!)) {
1653         # Analogous to the more general fix of dfe9444ca7881e71
1654         # Without this flags such as -m64 may not be passed to this compile,
1655         # which results in a byteorder of '1234' instead of '12345678', which
1656         # can then cause crashes.
1657
1658         if (extract_from_file('Configure', qr/xxx_prompt=y/)) {
1659             # 8e07c86ebc651fe9 or later
1660             # ("This is my patch  patch.1n  for perl5.001.")
1661             apply_patch(<<'EOPATCH');
1662 diff --git a/Configure b/Configure
1663 index 62249dd..c5c384e 100755
1664 --- a/Configure
1665 +++ b/Configure
1666 @@ -8247,7 +8247,7 @@ main()
1667  }
1668  EOCP
1669         xxx_prompt=y
1670 -       if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
1671 +       if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
1672                 dflt=`./try`
1673                 case "$dflt" in
1674                 [1-4][1-4][1-4][1-4]|12345678|87654321)
1675 EOPATCH
1676         } else {
1677             apply_patch(<<'EOPATCH');
1678 diff --git a/Configure b/Configure
1679 index 53649d5..f1cd64a 100755
1680 --- a/Configure
1681 +++ b/Configure
1682 @@ -6362,7 +6362,7 @@ main()
1683         printf("\n");
1684  }
1685  EOCP
1686 -       if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then
1687 +       if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 ; then
1688                 dflt=`./try`
1689                 case "$dflt" in
1690                 ????|????????) echo "(The test program ran ok.)";;
1691 EOPATCH
1692         }
1693     }
1694
1695     if ($major < 6 && !extract_from_file('Configure',
1696                                          qr!^\t-A\)$!)) {
1697         # This adds the -A option to Configure, which is incredibly useful
1698         # Effectively this is commits 02e93a22d20fc9a5, 5f83a3e9d818c3ad,
1699         # bde6b06b2c493fef, f7c3111703e46e0c and 2 lines of trailing whitespace
1700         # removed by 613d6c3e99b9decc, but applied at slightly different
1701         # locations to ensure a clean patch back to 5.000
1702         # Note, if considering patching to the intermediate revisions to fix
1703         # bugs in -A handling, f7c3111703e46e0c is from 2002, and hence
1704         # $major == 8
1705
1706         # To add to the fun, early patches add -K and -O options, and it's not
1707         # trivial to get patch to put the C<. ./posthint.sh> in the right place
1708         edit_file('Configure', sub {
1709                       my $code = shift;
1710                       $code =~ s/(optstr = ")([^"]+";\s*# getopt-style specification)/$1A:$2/
1711                           or die_255("Substitution failed");
1712                       $code =~ s!^(: who configured the system)!
1713 touch posthint.sh
1714 . ./posthint.sh
1715
1716 $1!ms
1717                           or die_255("Substitution failed");
1718                       return $code;
1719                   });
1720         apply_patch(<<'EOPATCH');
1721 diff --git a/Configure b/Configure
1722 index 4b55fa6..60c3c64 100755
1723 --- a/Configure
1724 +++ b/Configure
1725 @@ -1150,6 +1150,7 @@ set X `for arg in "$@"; do echo "X$arg"; done |
1726  eval "set $*"
1727  shift
1728  rm -f options.awk
1729 +rm -f posthint.sh
1730
1731  : set up default values
1732  fastread=''
1733 @@ -1172,6 +1173,56 @@ while test $# -gt 0; do
1734         case "$1" in
1735         -d) shift; fastread=yes;;
1736         -e) shift; alldone=cont;;
1737 +       -A)
1738 +           shift
1739 +           xxx=''
1740 +           yyy="$1"
1741 +           zzz=''
1742 +           uuu=undef
1743 +           case "$yyy" in
1744 +            *=*) zzz=`echo "$yyy"|sed 's!=.*!!'`
1745 +                 case "$zzz" in
1746 +                 *:*) zzz='' ;;
1747 +                 *)   xxx=append
1748 +                      zzz=" "`echo "$yyy"|sed 's!^[^=]*=!!'`
1749 +                      yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
1750 +                 esac
1751 +                 ;;
1752 +            esac
1753 +            case "$xxx" in
1754 +            '')  case "$yyy" in
1755 +                 *:*) xxx=`echo "$yyy"|sed 's!:.*!!'`
1756 +                      yyy=`echo "$yyy"|sed 's!^[^:]*:!!'`
1757 +                      zzz=`echo "$yyy"|sed 's!^[^=]*=!!'`
1758 +                      yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
1759 +                 *)   xxx=`echo "$yyy"|sed 's!:.*!!'`
1760 +                      yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` ;;
1761 +                 esac
1762 +                 ;;
1763 +            esac
1764 +           case "$xxx" in
1765 +           append)
1766 +               echo "$yyy=\"\${$yyy}$zzz\""    >> posthint.sh ;;
1767 +           clear)
1768 +               echo "$yyy=''"                  >> posthint.sh ;;
1769 +           define)
1770 +               case "$zzz" in
1771 +               '') zzz=define ;;
1772 +               esac
1773 +               echo "$yyy='$zzz'"              >> posthint.sh ;;
1774 +           eval)
1775 +               echo "eval \"$yyy=$zzz\""       >> posthint.sh ;;
1776 +           prepend)
1777 +               echo "$yyy=\"$zzz\${$yyy}\""    >> posthint.sh ;;
1778 +           undef)
1779 +               case "$zzz" in
1780 +               '') zzz="$uuu" ;;
1781 +               esac
1782 +               echo "$yyy=$zzz"                >> posthint.sh ;;
1783 +            *)  echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2 ;;
1784 +           esac
1785 +           shift
1786 +           ;;
1787         -f)
1788                 shift
1789                 cd ..
1790 EOPATCH
1791     }
1792
1793     if ($major < 8 && $^O eq 'aix') {
1794         edit_file('Configure', sub {
1795                       my $code = shift;
1796                       # Replicate commit a8c676c69574838b
1797                       # Whitespace allowed at the ends of /lib/syscalls.exp lines
1798                       # and half of commit c6912327ae30e6de
1799                       # AIX syscalls.exp scan: the syscall might be marked 32, 3264, or 64
1800                       $code =~ s{(\bsed\b.*\bsyscall)(?:\[0-9\]\*)?(\$.*/lib/syscalls\.exp)}
1801                                 {$1 . "[0-9]*[ \t]*" . $2}e;
1802                       return $code;
1803                   });
1804     }
1805
1806     if ($major < 8 && !extract_from_file('Configure',
1807                                          qr/^\t\tif test ! -t 0; then$/)) {
1808         # Before dfe9444ca7881e71, Configure would refuse to run if stdin was
1809         # not a tty. With that commit, the tty requirement was dropped for -de
1810         # and -dE
1811         # Commit aaeb8e512e8e9e14 dropped the tty requirement for -S
1812         # For those older versions, it's probably easiest if we simply remove
1813         # the sanity test.
1814         edit_file('Configure', sub {
1815                       my $code = shift;
1816                       $code =~ s/test ! -t 0/test Perl = rules/;
1817                       return $code;
1818                   });
1819     }
1820
1821     if ($major == 8 || $major == 9) {
1822         # Fix symbol detection to that of commit 373dfab3839ca168 if it's any
1823         # intermediate version 5129fff43c4fe08c or later, as the intermediate
1824         # versions don't work correctly on (at least) Sparc Linux.
1825         # 5129fff43c4fe08c adds the first mention of mistrustnm.
1826         # 373dfab3839ca168 removes the last mention of lc=""
1827         edit_file('Configure', sub {
1828                       my $code = shift;
1829                       return $code
1830                           if $code !~ /\btc="";/; # 373dfab3839ca168 or later
1831                       return $code
1832                           if $code !~ /\bmistrustnm\b/; # before 5129fff43c4fe08c
1833                       my $fixed = <<'EOC';
1834
1835 : is a C symbol defined?
1836 csym='tlook=$1;
1837 case "$3" in
1838 -v) tf=libc.tmp; tdc="";;
1839 -a) tf=libc.tmp; tdc="[]";;
1840 *) tlook="^$1\$"; tf=libc.list; tdc="()";;
1841 esac;
1842 tx=yes;
1843 case "$reuseval-$4" in
1844 true-) ;;
1845 true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;;
1846 esac;
1847 case "$tx" in
1848 yes)
1849         tval=false;
1850         if $test "$runnm" = true; then
1851                 if $contains $tlook $tf >/dev/null 2>&1; then
1852                         tval=true;
1853                 elif $test "$mistrustnm" = compile -o "$mistrustnm" = run; then
1854                         echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
1855                         $cc -o try $optimize $ccflags $ldflags try.c >/dev/null 2>&1 $libs && tval=true;
1856                         $test "$mistrustnm" = run -a -x try && { $run ./try$_exe >/dev/null 2>&1 || tval=false; };
1857                         $rm -f try$_exe try.c core core.* try.core;
1858                 fi;
1859         else
1860                 echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
1861                 $cc -o try $optimize $ccflags $ldflags try.c $libs >/dev/null 2>&1 && tval=true;
1862                 $rm -f try$_exe try.c;
1863         fi;
1864         ;;
1865 *)
1866         case "$tval" in
1867         $define) tval=true;;
1868         *) tval=false;;
1869         esac;
1870         ;;
1871 esac;
1872 eval "$2=$tval"'
1873
1874 EOC
1875                       $code =~ s/\n: is a C symbol defined\?\n.*?\neval "\$2=\$tval"'\n\n/$fixed/sm
1876                           or die_255("substitution failed");
1877                       return $code;
1878                   });
1879     }
1880
1881     if ($major < 10
1882         && extract_from_file('Configure', qr/^set malloc\.h i_malloc$/)) {
1883         # This is commit 01d07975f7ef0e7d, trimmed, with $compile inlined as
1884         # prior to bd9b35c97ad661cc Configure had the malloc.h test before the
1885         # definition of $compile.
1886         apply_patch(<<'EOPATCH');
1887 diff --git a/Configure b/Configure
1888 index 3d2e8b9..6ce7766 100755
1889 --- a/Configure
1890 +++ b/Configure
1891 @@ -6743,5 +6743,22 @@ set d_dosuid
1892
1893  : see if this is a malloc.h system
1894 -set malloc.h i_malloc
1895 -eval $inhdr
1896 +: we want a real compile instead of Inhdr because some systems have a
1897 +: malloc.h that just gives a compile error saying to use stdlib.h instead
1898 +echo " "
1899 +$cat >try.c <<EOCP
1900 +#include <stdlib.h>
1901 +#include <malloc.h>
1902 +int main () { return 0; }
1903 +EOCP
1904 +set try
1905 +if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then
1906 +    echo "<malloc.h> found." >&4
1907 +    val="$define"
1908 +else
1909 +    echo "<malloc.h> NOT found." >&4
1910 +    val="$undef"
1911 +fi
1912 +$rm -f try.c try
1913 +set i_malloc
1914 +eval $setvar
1915
1916 EOPATCH
1917     }
1918 }
1919
1920 sub patch_hints {
1921     if ($^O eq 'freebsd') {
1922         # There are rather too many version-specific FreeBSD hints fixes to
1923         # patch individually. Also, more than once the FreeBSD hints file has
1924         # been written in what turned out to be a rather non-future-proof style,
1925         # with case statements treating the most recent version as the
1926         # exception, instead of treating previous versions' behaviour explicitly
1927         # and changing the default to cater for the current behaviour. (As
1928         # strangely, future versions inherit the current behaviour.)
1929         checkout_file('hints/freebsd.sh');
1930     } elsif ($^O eq 'darwin') {
1931         if ($major < 8) {
1932             # We can't build on darwin without some of the data in the hints
1933             # file. Probably less surprising to use the earliest version of
1934             # hints/darwin.sh and then edit in place just below, than use
1935             # blead's version, as that would create a discontinuity at
1936             # f556e5b971932902 - before it, hints bugs would be "fixed", after
1937             # it they'd resurface. This way, we should give the illusion of
1938             # monotonic bug fixing.
1939             my $faking_it;
1940             if (!-f 'hints/darwin.sh') {
1941                 checkout_file('hints/darwin.sh', 'f556e5b971932902');
1942                 ++$faking_it;
1943             }
1944
1945             edit_file('hints/darwin.sh', sub {
1946                       my $code = shift;
1947                       # Part of commit 8f4f83badb7d1ba9, which mostly undoes
1948                       # commit 0511a818910f476c.
1949                       $code =~ s/^cppflags='-traditional-cpp';$/cppflags="\${cppflags} -no-cpp-precomp"/m;
1950                       # commit 14c11978e9b52e08/803bb6cc74d36a3f
1951                       # Without this, code in libperl.bundle links against op.o
1952                       # in preference to opmini.o on the linker command line,
1953                       # and hence miniperl tries to use File::Glob instead of
1954                       # csh
1955                       $code =~ s/^(lddlflags=)/ldflags="\${ldflags} -flat_namespace"\n$1/m;
1956                       # f556e5b971932902 also patches Makefile.SH with some
1957                       # special case code to deal with useshrplib for darwin.
1958                       # Given that post 5.8.0 the darwin hints default was
1959                       # changed to false, and it would be very complex to splice
1960                       # in that code in various versions of Makefile.SH back
1961                       # to 5.002, lets just turn it off.
1962                       $code =~ s/^useshrplib='true'/useshrplib='false'/m
1963                           if $faking_it;
1964
1965                       # Part of commit d235852b65d51c44
1966                       # Don't do this on a case sensitive HFS+ partition, as it
1967                       # breaks the build for 5.003 and earlier.
1968                       if ($case_insensitive
1969                           && $code !~ /^firstmakefile=GNUmakefile/) {
1970                           $code .= "\nfirstmakefile=GNUmakefile;\n";
1971                       }
1972
1973                       return $code;
1974                   });
1975         }
1976     } elsif ($^O eq 'netbsd') {
1977         if ($major < 6) {
1978             # These are part of commit 099685bc64c7dbce
1979             edit_file('hints/netbsd.sh', sub {
1980                           my $code = shift;
1981                           my $fixed = <<'EOC';
1982 case "$osvers" in
1983 0.9|0.8*)
1984         usedl="$undef"
1985         ;;
1986 *)
1987         if [ -f /usr/libexec/ld.elf_so ]; then
1988                 d_dlopen=$define
1989                 d_dlerror=$define
1990                 ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags"
1991                 cccdlflags="-DPIC -fPIC $cccdlflags"
1992                 lddlflags="--whole-archive -shared $lddlflags"
1993         elif [ "`uname -m`" = "pmax" ]; then
1994 # NetBSD 1.3 and 1.3.1 on pmax shipped an 'old' ld.so, which will not work.
1995                 d_dlopen=$undef
1996         elif [ -f /usr/libexec/ld.so ]; then
1997                 d_dlopen=$define
1998                 d_dlerror=$define
1999                 ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags"
2000 # we use -fPIC here because -fpic is *NOT* enough for some of the
2001 # extensions like Tk on some netbsd platforms (the sparc is one)
2002                 cccdlflags="-DPIC -fPIC $cccdlflags"
2003                 lddlflags="-Bforcearchive -Bshareable $lddlflags"
2004         else
2005                 d_dlopen=$undef
2006         fi
2007         ;;
2008 esac
2009 EOC
2010                           $code =~ s/^case "\$osvers" in\n0\.9\|0\.8.*?^esac\n/$fixed/ms;
2011                           return $code;
2012                       });
2013         }
2014     } elsif ($^O eq 'openbsd') {
2015         if ($major < 8) {
2016             checkout_file('hints/openbsd.sh', '43051805d53a3e4c')
2017                 unless -f 'hints/openbsd.sh';
2018             my $which = extract_from_file('hints/openbsd.sh',
2019                                           qr/# from (2\.8|3\.1) onwards/,
2020                                           '');
2021             if ($which eq '') {
2022                 my $was = extract_from_file('hints/openbsd.sh',
2023                                             qr/(lddlflags="(?:-Bforcearchive )?-Bshareable)/);
2024                 # This is commit 154d43cbcf57271c and parts of 5c75dbfa77b0949c
2025                 # and 29b5585702e5e025
2026                 apply_patch(sprintf <<'EOPATCH', $was);
2027 diff --git a/hints/openbsd.sh b/hints/openbsd.sh
2028 index a7d8bf2..5b79709 100644
2029 --- a/hints/openbsd.sh
2030 +++ b/hints/openbsd.sh
2031 @@ -37,7 +37,25 @@ OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax)
2032         # we use -fPIC here because -fpic is *NOT* enough for some of the
2033         # extensions like Tk on some OpenBSD platforms (ie: sparc)
2034         cccdlflags="-DPIC -fPIC $cccdlflags"
2035 -       %s $lddlflags"
2036 +       case "$osvers" in
2037 +       [01].*|2.[0-7]|2.[0-7].*)
2038 +               lddlflags="-Bshareable $lddlflags"
2039 +               ;;
2040 +       2.[8-9]|3.0)
2041 +               ld=${cc:-cc}
2042 +               lddlflags="-shared -fPIC $lddlflags"
2043 +               ;;
2044 +       *) # from 3.1 onwards
2045 +               ld=${cc:-cc}
2046 +               lddlflags="-shared -fPIC $lddlflags"
2047 +               libswanted=`echo $libswanted | sed 's/ dl / /'`
2048 +               ;;
2049 +       esac
2050 +
2051 +       # We need to force ld to export symbols on ELF platforms.
2052 +       # Without this, dlopen() is crippled.
2053 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
2054 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
2055         ;;
2056  esac
2057
2058 EOPATCH
2059             } elsif ($which eq '2.8') {
2060                 # This is parts of 5c75dbfa77b0949c and 29b5585702e5e025, and
2061                 # possibly eb9cd59d45ad2908
2062                 my $was = extract_from_file('hints/openbsd.sh',
2063                                             qr/lddlflags="(-shared(?: -fPIC)?) \$lddlflags"/);
2064
2065                 apply_patch(sprintf <<'EOPATCH', $was);
2066 --- a/hints/openbsd.sh  2011-10-21 17:25:20.000000000 +0200
2067 +++ b/hints/openbsd.sh  2011-10-21 16:58:43.000000000 +0200
2068 @@ -44,11 +44,21 @@
2069         [01].*|2.[0-7]|2.[0-7].*)
2070                 lddlflags="-Bshareable $lddlflags"
2071                 ;;
2072 -       *) # from 2.8 onwards
2073 +       2.[8-9]|3.0)
2074                 ld=${cc:-cc}
2075 -               lddlflags="%s $lddlflags"
2076 +               lddlflags="-shared -fPIC $lddlflags"
2077 +               ;;
2078 +       *) # from 3.1 onwards
2079 +               ld=${cc:-cc}
2080 +               lddlflags="-shared -fPIC $lddlflags"
2081 +               libswanted=`echo $libswanted | sed 's/ dl / /'`
2082                 ;;
2083         esac
2084 +
2085 +       # We need to force ld to export symbols on ELF platforms.
2086 +       # Without this, dlopen() is crippled.
2087 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
2088 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
2089         ;;
2090  esac
2091
2092 EOPATCH
2093             } elsif ($which eq '3.1'
2094                      && !extract_from_file('hints/openbsd.sh',
2095                                            qr/We need to force ld to export symbols on ELF platforms/)) {
2096                 # This is part of 29b5585702e5e025
2097                 apply_patch(<<'EOPATCH');
2098 diff --git a/hints/openbsd.sh b/hints/openbsd.sh
2099 index c6b6bc9..4839d04 100644
2100 --- a/hints/openbsd.sh
2101 +++ b/hints/openbsd.sh
2102 @@ -54,6 +54,11 @@ alpha-2.[0-8]|mips-*|vax-*|powerpc-2.[0-7]|m88k-*)
2103                 libswanted=`echo $libswanted | sed 's/ dl / /'`
2104                 ;;
2105         esac
2106 +
2107 +       # We need to force ld to export symbols on ELF platforms.
2108 +       # Without this, dlopen() is crippled.
2109 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
2110 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
2111         ;;
2112  esac
2113
2114 EOPATCH
2115             }
2116         }
2117     } elsif ($^O eq 'linux') {
2118         if ($major < 1) {
2119             # sparc linux seems to need the -Dbool=char -DHAS_BOOL part of
2120             # perl5.000 patch.0n: [address Configure and build issues]
2121             edit_file('hints/linux.sh', sub {
2122                           my $code = shift;
2123                           $code =~ s!-I/usr/include/bsd!-Dbool=char -DHAS_BOOL!g;
2124                           return $code;
2125                       });
2126         }
2127
2128         if ($major <= 9) {
2129             if (`uname -sm` =~ qr/^Linux sparc/) {
2130                 if (extract_from_file('hints/linux.sh', qr/sparc-linux/)) {
2131                     # Be sure to use -fPIC not -fpic on Linux/SPARC
2132                     apply_commit('f6527d0ef0c13ad4');
2133                 } elsif(!extract_from_file('hints/linux.sh',
2134                                            qr/^sparc-linux\)$/)) {
2135                     my $fh = open_or_die('hints/linux.sh', '>>');
2136                     print $fh <<'EOT' or die_255($!);
2137
2138 case "`uname -m`" in
2139 sparc*)
2140         case "$cccdlflags" in
2141         *-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;;
2142         *)       cccdlflags="$cccdlflags -fPIC" ;;
2143         esac
2144         ;;
2145 esac
2146 EOT
2147                     close_or_die($fh);
2148                 }
2149             }
2150         }
2151     } elsif ($^O eq 'solaris') {
2152         if (($major == 13 || $major == 14)
2153             && extract_from_file('hints/solaris_2.sh', qr/getconfldllflags/)) {
2154             apply_commit('c80bde4388070c45');
2155         }
2156     }
2157 }
2158
2159 sub patch_SH {
2160     # Cwd.xs added in commit 0d2079faa739aaa9. Cwd.pm moved to ext/ 8 years
2161     # later in commit 403f501d5b37ebf0
2162     if ($major > 0 && <*/Cwd/Cwd.xs>) {
2163         if ($major < 10
2164             && !extract_from_file('Makefile.SH', qr/^extra_dep=''$/)) {
2165             # The Makefile.PL for Unicode::Normalize needs
2166             # lib/unicore/CombiningClass.pl. Even without a parallel build, we
2167             # need a dependency to ensure that it builds. This is a variant of
2168             # commit 9f3ef600c170f61e. Putting this for earlier versions gives
2169             # us a spot on which to hang the edits below
2170             apply_patch(<<'EOPATCH');
2171 diff --git a/Makefile.SH b/Makefile.SH
2172 index f61d0db..6097954 100644
2173 --- a/Makefile.SH
2174 +++ b/Makefile.SH
2175 @@ -155,10 +155,20 @@ esac
2176
2177  : Prepare dependency lists for Makefile.
2178  dynamic_list=' '
2179 +extra_dep=''
2180  for f in $dynamic_ext; do
2181      : the dependency named here will never exist
2182        base=`echo "$f" | sed 's/.*\///'`
2183 -    dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext"
2184 +    this_target="lib/auto/$f/$base.$dlext"
2185 +    dynamic_list="$dynamic_list $this_target"
2186 +
2187 +    : Parallel makes reveal that we have some interdependencies
2188 +    case $f in
2189 +       Math/BigInt/FastCalc) extra_dep="$extra_dep
2190 +$this_target: lib/auto/List/Util/Util.$dlext" ;;
2191 +       Unicode/Normalize) extra_dep="$extra_dep
2192 +$this_target: lib/unicore/CombiningClass.pl" ;;
2193 +    esac
2194  done
2195
2196  static_list=' '
2197 @@ -987,2 +997,9 @@ n_dummy $(nonxs_ext):       miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE
2198         @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
2199 +!NO!SUBS!
2200 +
2201 +$spitshell >>Makefile <<EOF
2202 +$extra_dep
2203 +EOF
2204 +
2205 +$spitshell >>Makefile <<'!NO!SUBS!'
2206
2207 EOPATCH
2208         }
2209
2210         if ($major == 15 && $^O !~ /^(linux|darwin|.*bsd)$/
2211             && extract_from_file('Makefile.SH', qr/^V.* \?= /)) {
2212             # Remove the GNU-make-ism (which the BSD makes also support, but
2213             # most other makes choke on)
2214             apply_patch(<<'EOPATCH');
2215 diff --git a/Makefile.SH b/Makefile.SH
2216 index 94952bd..13e9001 100755
2217 --- a/Makefile.SH
2218 +++ b/Makefile.SH
2219 @@ -338,8 +338,8 @@ linux*|darwin)
2220  $spitshell >>$Makefile <<!GROK!THIS!
2221  # If you're going to use valgrind and it can't be invoked as plain valgrind
2222  # then you'll need to change this, or override it on the make command line.
2223 -VALGRIND ?= valgrind
2224 -VG_TEST  ?= ./perl -e 1 2>/dev/null
2225 +VALGRIND = valgrind
2226 +VG_TEST  = ./perl -e 1 2>/dev/null
2227
2228  !GROK!THIS!
2229         ;;
2230 EOPATCH
2231         }
2232
2233         if ($major == 11) {
2234             if (extract_from_file('patchlevel.h',
2235                                   qr/^#include "unpushed\.h"/)) {
2236                 # I had thought it easier to detect when building one of the 52
2237                 # commits with the original method of incorporating the git
2238                 # revision and drop parallel make flags. Commits shown by
2239                 # git log 46807d8e809cc127^..dcff826f70bf3f64^ ^d4fb0a1f15d1a1c4
2240                 # However, it's not actually possible to make miniperl for that
2241                 # configuration as-is, because the file .patchnum is only made
2242                 # as a side effect of target 'all'
2243                 # I also don't think that it's "safe" to simply run
2244                 # make_patchnum.sh before the build. We need the proper
2245                 # dependency rules in the Makefile to *stop* it being run again
2246                 # at the wrong time.
2247                 # This range is important because contains the commit that
2248                 # merges Schwern's y2038 work.
2249                 apply_patch(<<'EOPATCH');
2250 diff --git a/Makefile.SH b/Makefile.SH
2251 index 9ad8b6f..106e721 100644
2252 --- a/Makefile.SH
2253 +++ b/Makefile.SH
2254 @@ -540,9 +544,14 @@ sperl.i: perl.c $(h)
2255
2256  .PHONY: all translators utilities make_patchnum
2257
2258 -make_patchnum:
2259 +make_patchnum: lib/Config_git.pl
2260 +
2261 +lib/Config_git.pl: make_patchnum.sh
2262         sh $(shellflags) make_patchnum.sh
2263
2264 +# .patchnum, unpushed.h and lib/Config_git.pl are built by make_patchnum.sh
2265 +unpushed.h .patchnum: lib/Config_git.pl
2266 +
2267  # make sure that we recompile perl.c if .patchnum changes
2268  perl$(OBJ_EXT): .patchnum unpushed.h
2269
2270 EOPATCH
2271             } elsif (-f '.gitignore'
2272                      && extract_from_file('.gitignore', qr/^\.patchnum$/)) {
2273                 # 8565263ab8a47cda to 46807d8e809cc127^ inclusive.
2274                 edit_file('Makefile.SH', sub {
2275                               my $code = shift;
2276                               $code =~ s/^make_patchnum:\n/make_patchnum: .patchnum
2277
2278 .sha1: .patchnum
2279
2280 .patchnum: make_patchnum.sh
2281 /m;
2282                               return $code;
2283                           });
2284             } elsif (-f 'lib/.gitignore'
2285                      && extract_from_file('lib/.gitignore',
2286                                           qr!^/Config_git.pl!)
2287                      && !extract_from_file('Makefile.SH',
2288                                         qr/^uudmap\.h.*:bitcount.h$/)) {
2289                 # Between commits and dcff826f70bf3f64 and 0f13ebd5d71f8177^
2290                 edit_file('Makefile.SH', sub {
2291                               my $code = shift;
2292                               # Bug introduced by 344af494c35a9f0f
2293                               # fixed in 0f13ebd5d71f8177
2294                               $code =~ s{^(pod/perlapi\.pod) (pod/perlintern\.pod): }
2295                                         {$1: $2\n\n$2: }m;
2296                               # Bug introduced by efa50c51e3301a2c
2297                               # fixed in 0f13ebd5d71f8177
2298                               $code =~ s{^(uudmap\.h) (bitcount\.h): }
2299                                         {$1: $2\n\n$2: }m;
2300
2301                               # The rats nest of getting git_version.h correct
2302
2303                               if ($code =~ s{git_version\.h: stock_git_version\.h
2304 \tcp stock_git_version\.h git_version\.h}
2305                                             {}m) {
2306                                   # before 486cd780047ff224
2307
2308                                   # We probably can't build between
2309                                   # 953f6acfa20ec275^ and 8565263ab8a47cda
2310                                   # inclusive, but all commits in that range
2311                                   # relate to getting make_patchnum.sh working,
2312                                   # so it is extremely unlikely to be an
2313                                   # interesting bisect target. They will skip.
2314
2315                                   # No, don't spawn a submake if
2316                                   # make_patchnum.sh or make_patchnum.pl fails
2317                                   $code =~ s{\|\| \$\(MAKE\) miniperl.*}
2318                                             {}m;
2319                                   $code =~ s{^\t(sh.*make_patchnum\.sh.*)}
2320                                             {\t-$1}m;
2321
2322                                   # Use an external perl to run make_patchnum.pl
2323                                   # because miniperl still depends on
2324                                   # git_version.h
2325                                   $code =~ s{^\t.*make_patchnum\.pl}
2326                                             {\t-$^X make_patchnum.pl}m;
2327
2328
2329                                   # "Truth in advertising" - running
2330                                   # make_patchnum generates 2 files.
2331                                   $code =~ s{^make_patchnum:.*}{
2332 make_patchnum: lib/Config_git.pl
2333
2334 git_version.h: lib/Config_git.pl
2335
2336 perlmini\$(OBJ_EXT): git_version.h
2337
2338 lib/Config_git.pl:}m;
2339                               }
2340                               # Right, now we've corrected Makefile.SH to
2341                               # correctly describe how lib/Config_git.pl and
2342                               # git_version.h are made, we need to fix the rest
2343
2344                               # This emulates commit 2b63e250843b907e
2345                               # This might duplicate the rule stating that
2346                               # git_version.h depends on lib/Config_git.pl
2347                               # This is harmless.
2348                               $code =~ s{^(?:lib/Config_git\.pl )?git_version\.h: (.* make_patchnum\.pl.*)}
2349                                         {git_version.h: lib/Config_git.pl
2350
2351 lib/Config_git.pl: $1}m;
2352
2353                               # This emulates commits 0f13ebd5d71f8177 and
2354                               # and a04d4598adc57886. It ensures that
2355                               # lib/Config_git.pl is built before configpm,
2356                               # and that configpm is run exactly once.
2357                               $code =~ s{^(\$\(.*?\) )?(\$\(CONFIGPOD\))(: .*? configpm Porting/Glossary)( lib/Config_git\.pl)?}{
2358                                   # If present, other files depend on $(CONFIGPOD)
2359                                   ($1 ? "$1: $2\n\n" : '')
2360                                       # Then the rule we found
2361                                       . $2 . $3
2362                                           # Add dependency if not there
2363                                           . ($4 ? $4 : ' lib/Config_git.pl')
2364                               }me;
2365
2366                               return $code;
2367                           });
2368             }
2369         }
2370
2371         if ($major < 14) {
2372             # Commits dc0655f797469c47 and d11a62fe01f2ecb2
2373             edit_file('Makefile.SH', sub {
2374                           my $code = shift;
2375                           foreach my $ext (qw(Encode SDBM_File)) {
2376                               next if $code =~ /\b$ext\) extra_dep=/s;
2377                               $code =~ s!(\) extra_dep="\$extra_dep
2378 \$this_target: .*?" ;;)
2379 (    esac
2380 )!$1
2381         $ext) extra_dep="\$extra_dep
2382 \$this_target: lib/auto/Cwd/Cwd.\$dlext" ;;
2383 $2!;
2384                           }
2385                           return $code;
2386                       });
2387         }
2388     }
2389
2390     if ($major == 7) {
2391         # Remove commits 9fec149bb652b6e9 and 5bab1179608f81d8, which add/amend
2392         # rules to automatically run regen scripts that rebuild C headers. These
2393         # cause problems because a git checkout doesn't preserve relative file
2394         # modification times, hence the regen scripts may fire. This will
2395         # obscure whether the repository had the correct generated headers
2396         # checked in.
2397         # Also, the dependency rules for running the scripts were not correct,
2398         # which could cause spurious re-builds on re-running make, and can cause
2399         # complete build failures for a parallel make.
2400         if (extract_from_file('Makefile.SH',
2401                               qr/Writing it this way gives make a big hint to always run opcode\.pl before/)) {
2402             apply_commit('70c6e6715e8fec53');
2403         } elsif (extract_from_file('Makefile.SH',
2404                                    qr/^opcode\.h opnames\.h pp_proto\.h pp\.sym: opcode\.pl$/)) {
2405             revert_commit('9fec149bb652b6e9');
2406         }
2407     }
2408
2409     if ($^O eq 'aix' && $major >= 11 && $major <= 15
2410         && extract_from_file('makedef.pl', qr/^use Config/)) {
2411         edit_file('Makefile.SH', sub {
2412                       # The AIX part of commit e6807d8ab22b761c
2413                       # It's safe to substitute lib/Config.pm for config.sh
2414                       # as lib/Config.pm depends on config.sh
2415                       # If the tree is post e6807d8ab22b761c, the substitution
2416                       # won't match, which is harmless.
2417                       my $code = shift;
2418                       $code =~ s{^(perl\.exp:.* )config\.sh(\b.*)}
2419                                 {$1 . '$(CONFIGPM)' . $2}me;
2420                       return $code;
2421                   });
2422     }
2423
2424     # There was a bug in makedepend.SH which was fixed in version 96a8704c.
2425     # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
2426     # Remove this if you're actually bisecting a problem related to
2427     # makedepend.SH
2428     # If you do this, you may need to add in code to correct the output of older
2429     # makedepends, which don't correctly filter newer gcc output such as
2430     # <built-in>
2431     checkout_file('makedepend.SH');
2432
2433     if ($major < 4 && -f 'config.sh'
2434         && !extract_from_file('config.sh', qr/^trnl=/)) {
2435         # This seems to be necessary to avoid makedepend becoming confused,
2436         # and hanging on stdin. Seems that the code after
2437         # make shlist || ...here... is never run.
2438         edit_file('makedepend.SH', sub {
2439                       my $code = shift;
2440                       $code =~ s/^trnl='\$trnl'$/trnl='\\n'/m;
2441                       return $code;
2442                   });
2443     }
2444 }
2445
2446 sub patch_C {
2447     # This is ordered by $major, as it's likely that different platforms may
2448     # well want to share code.
2449
2450     if ($major == 2 && extract_from_file('perl.c', qr/^\tfclose\(e_fp\);$/)) {
2451         # need to patch perl.c to avoid calling fclose() twice on e_fp when
2452         # using -e
2453         # This diff is part of commit ab821d7fdc14a438. The second close was
2454         # introduced with perl-5.002, commit a5f75d667838e8e7
2455         # Might want a6c477ed8d4864e6 too, for the corresponding change to
2456         # pp_ctl.c (likely without this, eval will have "fun")
2457         apply_patch(<<'EOPATCH');
2458 diff --git a/perl.c b/perl.c
2459 index 03c4d48..3c814a2 100644
2460 --- a/perl.c
2461 +++ b/perl.c
2462 @@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
2463  #ifndef VMS  /* VMS doesn't have environ array */
2464      origenviron = environ;
2465  #endif
2466 +    e_tmpname = Nullch;
2467
2468      if (do_undump) {
2469
2470 @@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
2471      if (e_fp) {
2472         if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
2473             croak("Can't write to temp file for -e: %s", Strerror(errno));
2474 +       e_fp = Nullfp;
2475         argc++,argv--;
2476         scriptname = e_tmpname;
2477      }
2478 @@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
2479      curcop->cop_line = 0;
2480      curstash = defstash;
2481      preprocess = FALSE;
2482 -    if (e_fp) {
2483 -       fclose(e_fp);
2484 -       e_fp = Nullfp;
2485 +    if (e_tmpname) {
2486         (void)UNLINK(e_tmpname);
2487 +       Safefree(e_tmpname);
2488 +       e_tmpname = Nullch;
2489      }
2490
2491      /* now that script is parsed, we can modify record separator */
2492 @@ -1369,7 +1371,7 @@ SV *sv;
2493         scriptname = xfound;
2494      }
2495
2496 -    origfilename = savepv(e_fp ? "-e" : scriptname);
2497 +    origfilename = savepv(e_tmpname ? "-e" : scriptname);
2498      curcop->cop_filegv = gv_fetchfile(origfilename);
2499      if (strEQ(origfilename,"-"))
2500         scriptname = "";
2501
2502 EOPATCH
2503     }
2504
2505     if ($major < 3 && $^O eq 'openbsd'
2506         && !extract_from_file('pp_sys.c', qr/BSD_GETPGRP/)) {
2507         # Part of commit c3293030fd1b7489
2508         apply_patch(<<'EOPATCH');
2509 diff --git a/pp_sys.c b/pp_sys.c
2510 index 4608a2a..f0c9d1d 100644
2511 --- a/pp_sys.c
2512 +++ b/pp_sys.c
2513 @@ -2903,8 +2903,8 @@ PP(pp_getpgrp)
2514         pid = 0;
2515      else
2516         pid = SvIVx(POPs);
2517 -#ifdef USE_BSDPGRP
2518 -    value = (I32)getpgrp(pid);
2519 +#ifdef BSD_GETPGRP
2520 +    value = (I32)BSD_GETPGRP(pid);
2521  #else
2522      if (pid != 0)
2523         DIE("POSIX getpgrp can't take an argument");
2524 @@ -2933,8 +2933,8 @@ PP(pp_setpgrp)
2525      }
2526
2527      TAINT_PROPER("setpgrp");
2528 -#ifdef USE_BSDPGRP
2529 -    SETi( setpgrp(pid, pgrp) >= 0 );
2530 +#ifdef BSD_SETPGRP
2531 +    SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
2532  #else
2533      if ((pgrp != 0) || (pid != 0)) {
2534         DIE("POSIX setpgrp can't take an argument");
2535 EOPATCH
2536     }
2537
2538     if ($major < 4 && $^O eq 'openbsd') {
2539         my $bad;
2540         # Need changes from commit a6e633defa583ad5.
2541         # Commits c07a80fdfe3926b5 and f82b3d4130164d5f changed the same part
2542         # of perl.h
2543
2544         if (extract_from_file('perl.h',
2545                               qr/^#ifdef HAS_GETPGRP2$/)) {
2546             $bad = <<'EOBAD';
2547 ***************
2548 *** 57,71 ****
2549   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
2550   #define TAINT_ENV()   if (tainting) taint_env()
2551
2552 ! #ifdef HAS_GETPGRP2
2553 ! #   ifndef HAS_GETPGRP
2554 ! #     define HAS_GETPGRP
2555 ! #   endif
2556 ! #endif
2557 !
2558 ! #ifdef HAS_SETPGRP2
2559 ! #   ifndef HAS_SETPGRP
2560 ! #     define HAS_SETPGRP
2561 ! #   endif
2562   #endif
2563
2564 EOBAD
2565         } elsif (extract_from_file('perl.h',
2566                                    qr/Gack, you have one but not both of getpgrp2/)) {
2567             $bad = <<'EOBAD';
2568 ***************
2569 *** 56,76 ****
2570   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
2571   #define TAINT_ENV()   if (tainting) taint_env()
2572
2573 ! #if defined(HAS_GETPGRP2) && defined(HAS_SETPGRP2)
2574 ! #   define getpgrp getpgrp2
2575 ! #   define setpgrp setpgrp2
2576 ! #   ifndef HAS_GETPGRP
2577 ! #     define HAS_GETPGRP
2578 ! #   endif
2579 ! #   ifndef HAS_SETPGRP
2580 ! #     define HAS_SETPGRP
2581 ! #   endif
2582 ! #   ifndef USE_BSDPGRP
2583 ! #     define USE_BSDPGRP
2584 ! #   endif
2585 ! #else
2586 ! #   if defined(HAS_GETPGRP2) || defined(HAS_SETPGRP2)
2587 !       #include "Gack, you have one but not both of getpgrp2() and setpgrp2()."
2588 ! #   endif
2589   #endif
2590
2591 EOBAD
2592         } elsif (extract_from_file('perl.h',
2593                                    qr/^#ifdef USE_BSDPGRP$/)) {
2594             $bad = <<'EOBAD'
2595 ***************
2596 *** 91,116 ****
2597   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
2598   #define TAINT_ENV()   if (tainting) taint_env()
2599
2600 ! #ifdef USE_BSDPGRP
2601 ! #   ifdef HAS_GETPGRP
2602 ! #       define BSD_GETPGRP(pid) getpgrp((pid))
2603 ! #   endif
2604 ! #   ifdef HAS_SETPGRP
2605 ! #       define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
2606 ! #   endif
2607 ! #else
2608 ! #   ifdef HAS_GETPGRP2
2609 ! #       define BSD_GETPGRP(pid) getpgrp2((pid))
2610 ! #       ifndef HAS_GETPGRP
2611 ! #         define HAS_GETPGRP
2612 ! #     endif
2613 ! #   endif
2614 ! #   ifdef HAS_SETPGRP2
2615 ! #       define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
2616 ! #       ifndef HAS_SETPGRP
2617 ! #         define HAS_SETPGRP
2618 ! #     endif
2619 ! #   endif
2620   #endif
2621
2622   #ifndef _TYPES_               /* If types.h defines this it's easy. */
2623 EOBAD
2624         }
2625         if ($bad) {
2626             apply_patch(<<"EOPATCH");
2627 *** a/perl.h    2011-10-21 09:46:12.000000000 +0200
2628 --- b/perl.h    2011-10-21 09:46:12.000000000 +0200
2629 $bad--- 91,144 ----
2630   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
2631   #define TAINT_ENV()   if (tainting) taint_env()
2632
2633 ! /* XXX All process group stuff is handled in pp_sys.c.  Should these
2634 !    defines move there?  If so, I could simplify this a lot. --AD  9/96.
2635 ! */
2636 ! /* Process group stuff changed from traditional BSD to POSIX.
2637 !    perlfunc.pod documents the traditional BSD-style syntax, so we'll
2638 !    try to preserve that, if possible.
2639 ! */
2640 ! #ifdef HAS_SETPGID
2641 ! #  define BSD_SETPGRP(pid, pgrp)      setpgid((pid), (pgrp))
2642 ! #else
2643 ! #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
2644 ! #    define BSD_SETPGRP(pid, pgrp)    setpgrp((pid), (pgrp))
2645 ! #  else
2646 ! #    ifdef HAS_SETPGRP2  /* DG/UX */
2647 ! #      define BSD_SETPGRP(pid, pgrp)  setpgrp2((pid), (pgrp))
2648 ! #    endif
2649 ! #  endif
2650 ! #endif
2651 ! #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
2652 ! #  define HAS_SETPGRP  /* Well, effectively it does . . . */
2653 ! #endif
2654 !
2655 ! /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
2656 !     our life easier :-) so we'll try it.
2657 ! */
2658 ! #ifdef HAS_GETPGID
2659 ! #  define BSD_GETPGRP(pid)            getpgid((pid))
2660 ! #else
2661 ! #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
2662 ! #    define BSD_GETPGRP(pid)          getpgrp((pid))
2663 ! #  else
2664 ! #    ifdef HAS_GETPGRP2  /* DG/UX */
2665 ! #      define BSD_GETPGRP(pid)                getpgrp2((pid))
2666 ! #    endif
2667 ! #  endif
2668 ! #endif
2669 ! #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
2670 ! #  define HAS_GETPGRP  /* Well, effectively it does . . . */
2671 ! #endif
2672 !
2673 ! /* These are not exact synonyms, since setpgrp() and getpgrp() may
2674 !    have different behaviors, but perl.h used to define USE_BSDPGRP
2675 !    (prior to 5.003_05) so some extension might depend on it.
2676 ! */
2677 ! #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
2678 ! #  ifndef USE_BSDPGRP
2679 ! #    define USE_BSDPGRP
2680 ! #  endif
2681   #endif
2682
2683   #ifndef _TYPES_               /* If types.h defines this it's easy. */
2684 EOPATCH
2685         }
2686     }
2687
2688     if ($major < 4 && $^O eq 'hpux'
2689         && extract_from_file('sv.c', qr/i = _filbuf\(/)) {
2690             apply_patch(<<'EOPATCH');
2691 diff --git a/sv.c b/sv.c
2692 index a1f1d60..0a806f1 100644
2693 --- a/sv.c
2694 +++ b/sv.c
2695 @@ -2641,7 +2641,7 @@ I32 append;
2696
2697         FILE_cnt(fp) = cnt;             /* deregisterize cnt and ptr */
2698         FILE_ptr(fp) = ptr;
2699 -       i = _filbuf(fp);                /* get more characters */
2700 +       i = __filbuf(fp);               /* get more characters */
2701         cnt = FILE_cnt(fp);
2702         ptr = FILE_ptr(fp);             /* reregisterize cnt and ptr */
2703
2704
2705 EOPATCH
2706     }
2707
2708     if ($major == 4 && extract_from_file('scope.c', qr/\(SV\*\)SSPOPINT/)) {
2709         # [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void)
2710         # Fixes a bug introduced in 161b7d1635bc830b
2711         apply_commit('9002cb76ec83ef7f');
2712     }
2713
2714     if ($major == 4 && extract_from_file('av.c', qr/AvARRAY\(av\) = 0;/)) {
2715         # Fixes a bug introduced in 1393e20655efb4bc
2716         apply_commit('e1c148c28bf3335b', 'av.c');
2717     }
2718
2719     if ($major == 4) {
2720         my $rest = extract_from_file('perl.c', qr/delimcpy(.*)/);
2721         if (defined $rest and $rest !~ /,$/) {
2722             # delimcpy added in fc36a67e8855d031, perl.c refactored to use it.
2723             # bug introduced in 2a92aaa05aa1acbf, fixed in 8490252049bf42d3
2724             # code then moved to util.c in commit 491527d0220de34e
2725             apply_patch(<<'EOPATCH');
2726 diff --git a/perl.c b/perl.c
2727 index 4eb69e3..54bbb00 100644
2728 --- a/perl.c
2729 +++ b/perl.c
2730 @@ -1735,7 +1735,7 @@ SV *sv;
2731             if (len < sizeof tokenbuf)
2732                 tokenbuf[len] = '\0';
2733  #else  /* ! (atarist || DOSISH) */
2734 -           s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend
2735 +           s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
2736                          ':',
2737                          &len);
2738  #endif /* ! (atarist || DOSISH) */
2739 EOPATCH
2740         }
2741     }
2742
2743     if ($major == 4 && $^O eq 'linux') {
2744         # Whilst this is fixed properly in f0784f6a4c3e45e1 which provides the
2745         # Configure probe, it's easier to back out the problematic changes made
2746         # in these previous commits.
2747
2748         # In maint-5.004, the simplest addition is to "correct" the file to
2749         # use the same pre-processor macros as blead had used. Whilst commit
2750         # 9b599b2a63d2324d (reverted below) is described as
2751         # [win32] merge change#887 from maintbranch
2752         # it uses __sun__ and __svr4__ instead of the __sun and __SVR4 of the
2753         # maint branch commit 6cdf74fe31f049dc
2754
2755         edit_file('doio.c', sub {
2756                       my $code = shift;
2757                       $code =~ s{defined\(__sun\) && defined\(__SVR4\)}
2758                                 {defined(__sun__) && defined(__svr4__)}g;
2759                       return $code;
2760                   });
2761
2762         if (extract_from_file('doio.c',
2763                               qr!^/\* XXX REALLY need metaconfig test \*/$!)) {
2764             revert_commit('4682965a1447ea44', 'doio.c');
2765         }
2766         if (my $token = extract_from_file('doio.c',
2767                                           qr!^#if (defined\(__sun(?:__)?\)) && defined\(__svr4__\) /\* XXX Need metaconfig test \*/$!)) {
2768             my $patch = `git show -R 9b599b2a63d2324d doio.c`;
2769             $patch =~ s/defined\(__sun__\)/$token/g;
2770             apply_patch($patch);
2771         }
2772         if (extract_from_file('doio.c',
2773                               qr!^/\* linux \(and Solaris2\?\) uses :$!)) {
2774             revert_commit('8490252049bf42d3', 'doio.c');
2775         }
2776         if (extract_from_file('doio.c',
2777                               qr/^          unsemds.buf = &semds;$/)) {
2778             revert_commit('8e591e46b4c6543e');
2779         }
2780         if (extract_from_file('doio.c',
2781                               qr!^#ifdef __linux__      /\* XXX Need metaconfig test \*/$!)) {
2782             # Reverts part of commit 3e3baf6d63945cb6
2783             apply_patch(<<'EOPATCH');
2784 diff --git b/doio.c a/doio.c
2785 index 62b7de9..0d57425 100644
2786 --- b/doio.c
2787 +++ a/doio.c
2788 @@ -1333,9 +1331,6 @@ SV **sp;
2789      char *a;
2790      I32 id, n, cmd, infosize, getinfo;
2791      I32 ret = -1;
2792 -#ifdef __linux__       /* XXX Need metaconfig test */
2793 -    union semun unsemds;
2794 -#endif
2795
2796      id = SvIVx(*++mark);
2797      n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
2798 @@ -1364,29 +1359,11 @@ SV **sp;
2799             infosize = sizeof(struct semid_ds);
2800         else if (cmd == GETALL || cmd == SETALL)
2801         {
2802 -#ifdef __linux__       /* XXX Need metaconfig test */
2803 -/* linux uses :
2804 -   int semctl (int semid, int semnun, int cmd, union semun arg)
2805 -
2806 -       union semun {
2807 -            int val;
2808 -            struct semid_ds *buf;
2809 -            ushort *array;
2810 -       };
2811 -*/
2812 -            union semun semds;
2813 -           if (semctl(id, 0, IPC_STAT, semds) == -1)
2814 -#else
2815             struct semid_ds semds;
2816             if (semctl(id, 0, IPC_STAT, &semds) == -1)
2817 -#endif
2818                 return -1;
2819             getinfo = (cmd == GETALL);
2820 -#ifdef __linux__       /* XXX Need metaconfig test */
2821 -           infosize = semds.buf->sem_nsems * sizeof(short);
2822 -#else
2823             infosize = semds.sem_nsems * sizeof(short);
2824 -#endif
2825                 /* "short" is technically wrong but much more portable
2826                    than guessing about u_?short(_t)? */
2827         }
2828 @@ -1429,12 +1406,7 @@ SV **sp;
2829  #endif
2830  #ifdef HAS_SEM
2831      case OP_SEMCTL:
2832 -#ifdef __linux__       /* XXX Need metaconfig test */
2833 -        unsemds.buf = (struct semid_ds *)a;
2834 -       ret = semctl(id, n, cmd, unsemds);
2835 -#else
2836         ret = semctl(id, n, cmd, (struct semid_ds *)a);
2837 -#endif
2838         break;
2839  #endif
2840  #ifdef HAS_SHM
2841 EOPATCH
2842         }
2843         # Incorrect prototype added as part of 8ac853655d9b7447, fixed as part
2844         # of commit dc45a647708b6c54, with at least one intermediate
2845         # modification. Correct prototype for gethostbyaddr has socklen_t
2846         # second. Linux has uint32_t first for getnetbyaddr.
2847         # Easiest just to remove, instead of attempting more complex patching.
2848         # Something similar may be needed on other platforms.
2849         edit_file('pp_sys.c', sub {
2850                       my $code = shift;
2851                       $code =~ s/^    struct hostent \*(?:PerlSock_)?gethostbyaddr\([^)]+\);$//m;
2852                       $code =~ s/^    struct netent \*getnetbyaddr\([^)]+\);$//m;
2853                       return $code;
2854                   });
2855     }
2856
2857     if ($major < 5 && $^O eq 'aix'
2858         && !extract_from_file('pp_sys.c',
2859                               qr/defined\(HOST_NOT_FOUND\) && !defined\(h_errno\)/)) {
2860         # part of commit dc45a647708b6c54
2861         # Andy Dougherty's configuration patches (Config_63-01 up to 04).
2862         apply_patch(<<'EOPATCH')
2863 diff --git a/pp_sys.c b/pp_sys.c
2864 index c2fcb6f..efa39fb 100644
2865 --- a/pp_sys.c
2866 +++ b/pp_sys.c
2867 @@ -54,7 +54,7 @@ extern "C" int syscall(unsigned long,...);
2868  #endif
2869  #endif
2870
2871 -#ifdef HOST_NOT_FOUND
2872 +#if defined(HOST_NOT_FOUND) && !defined(h_errno)
2873  extern int h_errno;
2874  #endif
2875
2876 EOPATCH
2877     }
2878
2879     if ($major == 5
2880         && `git rev-parse HEAD` eq "22c35a8c2392967a5ba6b5370695be464bd7012c\n") {
2881         # Commit 22c35a8c2392967a is significant,
2882         # "phase 1 of somewhat major rearrangement of PERL_OBJECT stuff"
2883         # but doesn't build due to 2 simple errors. blead in this broken state
2884         # was merged to the cfgperl branch, and then these were immediately
2885         # corrected there. cfgperl (with the fixes) was merged back to blead.
2886         # The resultant rather twisty maze of commits looks like this:
2887
2888 =begin comment
2889
2890 * | |   commit 137225782c183172f360c827424b9b9f8adbef0e
2891 |\ \ \  Merge: 22c35a8 2a8ee23
2892 | |/ /  Author: Gurusamy Sarathy <gsar@cpan.org>
2893 | | |   Date:   Fri Oct 30 17:38:36 1998 +0000
2894 | | |
2895 | | |       integrate cfgperl tweaks into mainline
2896 | | |
2897 | | |       p4raw-id: //depot/perl@2144
2898 | | |
2899 | * | commit 2a8ee23279873759693fa83eca279355db2b665c
2900 | | | Author: Jarkko Hietaniemi <jhi@iki.fi>
2901 | | | Date:   Fri Oct 30 13:27:39 1998 +0000
2902 | | |
2903 | | |     There can be multiple yacc/bison errors.
2904 | | |
2905 | | |     p4raw-id: //depot/cfgperl@2143
2906 | | |
2907 | * | commit 93fb2ac393172fc3e2c14edb20b718309198abbc
2908 | | | Author: Jarkko Hietaniemi <jhi@iki.fi>
2909 | | | Date:   Fri Oct 30 13:18:43 1998 +0000
2910 | | |
2911 | | |     README.posix-bc update.
2912 | | |
2913 | | |     p4raw-id: //depot/cfgperl@2142
2914 | | |
2915 | * | commit 4ec43091e8e6657cb260b5e563df30aaa154effe
2916 | | | Author: Jarkko Hietaniemi <jhi@iki.fi>
2917 | | | Date:   Fri Oct 30 09:12:59 1998 +0000
2918 | | |
2919 | | |     #2133 fallout.
2920 | | |
2921 | | |     p4raw-id: //depot/cfgperl@2141
2922 | | |
2923 | * |   commit 134ca994cfefe0f613d43505a885e4fc2100b05c
2924 | |\ \  Merge: 7093112 22c35a8
2925 | |/ /  Author: Jarkko Hietaniemi <jhi@iki.fi>
2926 |/| |   Date:   Fri Oct 30 08:43:18 1998 +0000
2927 | | |
2928 | | |       Integrate from mainperl.
2929 | | |
2930 | | |       p4raw-id: //depot/cfgperl@2140
2931 | | |
2932 * | | commit 22c35a8c2392967a5ba6b5370695be464bd7012c
2933 | | | Author: Gurusamy Sarathy <gsar@cpan.org>
2934 | | | Date:   Fri Oct 30 02:51:39 1998 +0000
2935 | | |
2936 | | |     phase 1 of somewhat major rearrangement of PERL_OBJECT stuff
2937 | | |     (objpp.h is gone, embed.pl now does some of that); objXSUB.h
2938 | | |     should soon be automated also; the global variables that
2939 | | |     escaped the PL_foo conversion are now reined in; renamed
2940 | | |     MAGIC in regcomp.h to REG_MAGIC to avoid collision with the
2941 | | |     type of same name; duplicated lists of pp_things in various
2942 | | |     places is now gone; result has only been tested on win32
2943 | | |
2944 | | |     p4raw-id: //depot/perl@2133
2945
2946 =end comment
2947
2948 =cut
2949
2950         # and completely confuses git bisect (and at least me), causing it to
2951         # the bisect run to confidently return the wrong answer, an unrelated
2952         # commit on the cfgperl branch.
2953
2954         apply_commit('4ec43091e8e6657c');
2955     }
2956
2957     if ($major == 5
2958         && extract_from_file('pp_sys.c', qr/PERL_EFF_ACCESS_R_OK/)
2959         && !extract_from_file('pp_sys.c', qr/XXX Configure test needed for eaccess/)) {
2960         # Between 5ff3f7a4e03a6b10 and c955f1177b2e311d^
2961         # This is the meat of commit c955f1177b2e311d (without the other
2962         # indenting changes that would cause a conflict).
2963         # Without this 538 revisions won't build on (at least) Linux
2964         apply_patch(<<'EOPATCH');
2965 diff --git a/pp_sys.c b/pp_sys.c
2966 index d60c8dc..867dee4 100644
2967 --- a/pp_sys.c
2968 +++ b/pp_sys.c
2969 @@ -198,9 +198,18 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
2970  #   if defined(I_SYS_SECURITY)
2971  #       include <sys/security.h>
2972  #   endif
2973 -#   define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
2974 -#   define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
2975 -#   define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
2976 +    /* XXX Configure test needed for eaccess */
2977 +#   ifdef ACC_SELF
2978 +        /* HP SecureWare */
2979 +#       define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
2980 +#       define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
2981 +#       define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
2982 +#   else
2983 +        /* SCO */
2984 +#       define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK))
2985 +#       define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK))
2986 +#       define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK))
2987 +#   endif
2988  #endif
2989
2990  #if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF)
2991 EOPATCH
2992     }
2993
2994     if ($major == 5
2995         && extract_from_file('mg.c', qr/If we're still on top of the stack, pop us off/)
2996         && !extract_from_file('mg.c', qr/PL_savestack_ix -= popval/)) {
2997         # Fix up commit 455ece5e082708b1:
2998         # SSNEW() API for allocating memory on the savestack
2999         # Message-Id: <tqemtae338.fsf@puma.genscan.com>
3000         # Subject: [PATCH 5.005_51] (was: why SAVEDESTRUCTOR()...)
3001         apply_commit('3c8a44569607336e', 'mg.c');
3002     }
3003
3004     if ($major == 5) {
3005         if (extract_from_file('doop.c', qr/croak\(no_modify\);/)
3006             && extract_from_file('doop.c', qr/croak\(PL_no_modify\);/)) {
3007             # Whilst the log suggests that this would only fix 5 commits, in
3008             # practice this area of history is a complete tarpit, and git bisect
3009             # gets very confused by the skips in the middle of the back and
3010             # forth merging between //depot/perl and //depot/cfgperl
3011             apply_commit('6393042b638dafd3');
3012         }
3013
3014         # One error "fixed" with another:
3015         if (extract_from_file('pp_ctl.c',
3016                               qr/\Qstatic void *docatch_body _((void *o));\E/)) {
3017             apply_commit('5b51e982882955fe');
3018         }
3019         # Which is then fixed by this:
3020         if (extract_from_file('pp_ctl.c',
3021                               qr/\Qstatic void *docatch_body _((valist\E/)) {
3022             apply_commit('47aa779ee4c1a50e');
3023         }
3024
3025         if (extract_from_file('thrdvar.h', qr/PERLVARI\(Tprotect/)
3026             && !extract_from_file('embedvar.h', qr/PL_protect/)) {
3027             # Commit 312caa8e97f1c7ee didn't update embedvar.h
3028             apply_commit('e0284a306d2de082', 'embedvar.h');
3029         }
3030     }
3031
3032     if ($major == 5
3033         && extract_from_file('sv.c',
3034                              qr/PerlDir_close\(IoDIRP\((?:\(IO\*\))?sv\)\);/)
3035         && !(extract_from_file('toke.c',
3036                                qr/\QIoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL\E/)
3037              || extract_from_file('toke.c',
3038                                   qr/\QIoDIRP(datasv) = (DIR*)NULL;\E/))) {
3039         # Commit 93578b34124e8a3b, //depot/perl@3298
3040         # close directory handles properly when localized,
3041         # tweaked slightly by commit 1236053a2c722e2b,
3042         # add test case for change#3298
3043         #
3044         # The fix is the last part of:
3045         #
3046         # various fixes for clean build and test on win32; configpm broken,
3047         # needed to open myconfig.SH rather than myconfig; sundry adjustments
3048         # to bytecode stuff; tweaks to DYNAMIC_ENV_FETCH code to make it
3049         # work under win32; getenv_sv() changed to getenv_len() since SVs
3050         # aren't visible in the lower echelons; remove bogus exports from
3051         # config.sym; PERL_OBJECT-ness for C++ exception support; null out
3052         # IoDIRP in filter_del() or sv_free() will attempt to close it
3053         #
3054         # The changed code is modified subsequently by commit e0c198038146b7a4
3055         apply_commit('a6c403648ecd5cc7', 'toke.c');
3056     }
3057
3058     if ($major < 6 && $^O eq 'netbsd'
3059         && !extract_from_file('unixish.h',
3060                               qr/defined\(NSIG\).*defined\(__NetBSD__\)/)) {
3061         apply_patch(<<'EOPATCH')
3062 diff --git a/unixish.h b/unixish.h
3063 index 2a6cbcd..eab2de1 100644
3064 --- a/unixish.h
3065 +++ b/unixish.h
3066 @@ -89,7 +89,7 @@
3067   */
3068  /* #define ALTERNATE_SHEBANG "#!" / **/
3069
3070 -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
3071 +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
3072  # include <signal.h>
3073  #endif
3074
3075 EOPATCH
3076     }
3077
3078     if ($major == 7 && $^O eq 'aix' &&
3079         extract_from_file('ext/List/Util/Util.xs', qr/PUSHBLOCK/)
3080         && !extract_from_file('makedef.pl', qr/^Perl_cxinc/)) {
3081         # Need this to get List::Utils 1.03 and later to compile.
3082         # 1.03 also expects to call Perl_pp_rand. Commit d3632a54487acc5f
3083         # fixes this (for the unthreaded case), but it's not until 1.05,
3084         # two days later, that this is fixed properly.
3085         apply_commit('cbb96eed3f175499');
3086     }
3087
3088     if (($major >= 7 || $major <= 9) && $^O eq 'openbsd'
3089         && `uname -m` eq "sparc64\n"
3090         # added in 2000 by commit cb434fcc98ac25f5:
3091         && extract_from_file('regexec.c',
3092                              qr!/\* No need to save/restore up to this paren \*/!)
3093         # re-indented in 2006 by commit 95b2444054382532:
3094         && extract_from_file('regexec.c', qr/^\t\tCURCUR cc;$/)) {
3095         # Need to work around a bug in (at least) OpenBSD's 4.6's sparc64 #
3096         # compiler ["gcc (GCC) 3.3.5 (propolice)"]. Between commits
3097         # 3ec562b0bffb8b8b (2002) and 1a4fad37125bac3e^ (2005) the darling thing
3098         # fails to compile any code for the statement cc.oldcc = PL_regcc;
3099         #
3100         # If you refactor the code to "fix" that, or force the issue using set
3101         # in the debugger, the stack smashing detection code fires on return
3102         # from S_regmatch(). Turns out that the compiler doesn't allocate any
3103         # (or at least enough) space for cc.
3104         #
3105         # Restore the "uninitialised" value for cc before function exit, and the
3106         # stack smashing code is placated.  "Fix" 3ec562b0bffb8b8b (which
3107         # changes the size of auto variables used elsewhere in S_regmatch), and
3108         # the crash is visible back to bc517b45fdfb539b (which also changes
3109         # buffer sizes). "Unfix" 1a4fad37125bac3e and the crash is visible until
3110         # 5b47454deb66294b.  Problem goes away if you compile with -O, or hack
3111         # the code as below.
3112         #
3113         # Hence this turns out to be a bug in (old) gcc. Not a security bug we
3114         # still need to fix.
3115         apply_patch(<<'EOPATCH');
3116 diff --git a/regexec.c b/regexec.c
3117 index 900b491..6251a0b 100644
3118 --- a/regexec.c
3119 +++ b/regexec.c
3120 @@ -2958,7 +2958,11 @@ S_regmatch(pTHX_ regnode *prog)
3121                                 I,I
3122   *******************************************************************/
3123         case CURLYX: {
3124 -               CURCUR cc;
3125 +           union {
3126 +               CURCUR hack_cc;
3127 +               char hack_buff[sizeof(CURCUR) + 1];
3128 +           } hack;
3129 +#define cc hack.hack_cc
3130                 CHECKPOINT cp = PL_savestack_ix;
3131                 /* No need to save/restore up to this paren */
3132                 I32 parenfloor = scan->flags;
3133 @@ -2983,6 +2987,7 @@ S_regmatch(pTHX_ regnode *prog)
3134                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
3135                 regcpblow(cp);
3136                 PL_regcc = cc.oldcc;
3137 +#undef cc
3138                 saySAME(n);
3139             }
3140             /* NOT REACHED */
3141 EOPATCH
3142 }
3143
3144     if ($major < 8 && $^O eq 'openbsd'
3145         && !extract_from_file('perl.h', qr/include <unistd\.h>/)) {
3146         # This is part of commit 3f270f98f9305540, applied at a slightly
3147         # different location in perl.h, where the context is stable back to
3148         # 5.000
3149         apply_patch(<<'EOPATCH');
3150 diff --git a/perl.h b/perl.h
3151 index 9418b52..b8b1a7c 100644
3152 --- a/perl.h
3153 +++ b/perl.h
3154 @@ -496,6 +496,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
3155  #   include <sys/param.h>
3156  #endif
3157
3158 +/* If this causes problems, set i_unistd=undef in the hint file.  */
3159 +#ifdef I_UNISTD
3160 +#   include <unistd.h>
3161 +#endif
3162
3163  /* Use all the "standard" definitions? */
3164  #if defined(STANDARD_C) && defined(I_STDLIB)
3165 EOPATCH
3166     }
3167 }
3168
3169 sub patch_ext {
3170     if (-f 'ext/POSIX/Makefile.PL'
3171         && extract_from_file('ext/POSIX/Makefile.PL',
3172                              qr/Explicitly avoid including/)) {
3173         # commit 6695a346c41138df, which effectively reverts 170888cff5e2ffb7
3174
3175         # PERL5LIB is populated by make_ext.pl with paths to the modules we need
3176         # to run, don't override this with "../../lib" since that may not have
3177         # been populated yet in a parallel build.
3178         apply_commit('6695a346c41138df');
3179     }
3180
3181     if (-f 'ext/Hash/Util/Makefile.PL'
3182         && extract_from_file('ext/Hash/Util/Makefile.PL',
3183                              qr/\bDIR\b.*'FieldHash'/)) {
3184         # ext/Hash/Util/Makefile.PL should not recurse to FieldHash's Makefile.PL
3185         # *nix, VMS and Win32 all know how to (and have to) call the latter directly.
3186         # As is, targets in ext/Hash/Util/FieldHash get called twice, which may result
3187         # in race conditions, and certainly messes up make clean; make distclean;
3188         apply_commit('550428fe486b1888');
3189     }
3190
3191     if ($major < 8 && $^O eq 'darwin' && !-f 'ext/DynaLoader/dl_dyld.xs') {
3192         checkout_file('ext/DynaLoader/dl_dyld.xs', 'f556e5b971932902');
3193         apply_patch(<<'EOPATCH');
3194 diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
3195 --- a/ext/DynaLoader/dl_dyld.xs~        2011-10-11 21:41:27.000000000 +0100
3196 +++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:42:20.000000000 +0100
3197 @@ -41,6 +41,35 @@
3198  #include "perl.h"
3199  #include "XSUB.h"
3200
3201 +#ifndef pTHX
3202 +#  define pTHX         void
3203 +#  define pTHX_
3204 +#endif
3205 +#ifndef aTHX
3206 +#  define aTHX
3207 +#  define aTHX_
3208 +#endif
3209 +#ifndef dTHX
3210 +#  define dTHXa(a)     extern int Perl___notused(void)
3211 +#  define dTHX         extern int Perl___notused(void)
3212 +#endif
3213 +
3214 +#ifndef Perl_form_nocontext
3215 +#  define Perl_form_nocontext form
3216 +#endif
3217 +
3218 +#ifndef Perl_warn_nocontext
3219 +#  define Perl_warn_nocontext warn
3220 +#endif
3221 +
3222 +#ifndef PTR2IV
3223 +#  define PTR2IV(p)    (IV)(p)
3224 +#endif
3225 +
3226 +#ifndef get_av
3227 +#  define get_av perl_get_av
3228 +#endif
3229 +
3230  #define DL_LOADONCEONLY
3231
3232  #include "dlutils.c"   /* SaveError() etc      */
3233 @@ -185,7 +191,7 @@
3234      CODE:
3235      DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
3236      if (flags & 0x01)
3237 -       Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
3238 +       Perl_warn_nocontext("Can't make loaded symbols global on this platform while loading %s",filename);
3239      RETVAL = dlopen(filename, mode) ;
3240      DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
3241      ST(0) = sv_newmortal() ;
3242 EOPATCH
3243         if ($major < 4 && !extract_from_file('util.c', qr/^form/m)) {
3244             apply_patch(<<'EOPATCH');
3245 diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
3246 --- a/ext/DynaLoader/dl_dyld.xs~        2011-10-11 21:56:25.000000000 +0100
3247 +++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 22:00:00.000000000 +0100
3248 @@ -60,6 +60,18 @@
3249  #  define get_av perl_get_av
3250  #endif
3251
3252 +static char *
3253 +form(char *pat, ...)
3254 +{
3255 +    char *retval;
3256 +    va_list args;
3257 +    va_start(args, pat);
3258 +    vasprintf(&retval, pat, &args);
3259 +    va_end(args);
3260 +    SAVEFREEPV(retval);
3261 +    return retval;
3262 +}
3263 +
3264  #define DL_LOADONCEONLY
3265
3266  #include "dlutils.c"   /* SaveError() etc      */
3267 EOPATCH
3268         }
3269     }
3270
3271     if ($major < 10) {
3272         if ($unfixable_db_file) {
3273             # Nothing we can do.
3274         } elsif (!extract_from_file('ext/DB_File/DB_File.xs',
3275                                     qr/^#ifdef AT_LEAST_DB_4_1$/)) {
3276             # This line is changed by commit 3245f0580c13b3ab
3277             my $line = extract_from_file('ext/DB_File/DB_File.xs',
3278                                          qr/^(        status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/);
3279             apply_patch(<<"EOPATCH");
3280 diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
3281 index 489ba96..fba8ded 100644
3282 --- a/ext/DB_File/DB_File.xs
3283 +++ b/ext/DB_File/DB_File.xs
3284 \@\@ -183,4 +187,8 \@\@
3285  #endif
3286
3287 +#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
3288 +#    define AT_LEAST_DB_4_1
3289 +#endif
3290 +
3291  /* map version 2 features & constants onto their version 1 equivalent */
3292
3293 \@\@ -1334,7 +1419,12 \@\@ SV *   sv ;
3294  #endif
3295
3296 +#ifdef AT_LEAST_DB_4_1
3297 +        status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
3298 +                               Flags, mode) ;
3299 +#else
3300  $line
3301                                 Flags, mode) ;
3302 +#endif
3303         /* printf("open returned %d %s\\n", status, db_strerror(status)) ; */
3304
3305 EOPATCH
3306         }
3307     }
3308
3309     if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') {
3310         edit_file('ext/IPC/SysV/SysV.xs', sub {
3311                       my $xs = shift;
3312                       my $fixed = <<'EOFIX';
3313
3314 #include <sys/types.h>
3315 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3316 #ifndef HAS_SEM
3317 #   include <sys/ipc.h>
3318 #endif
3319 #   ifdef HAS_MSG
3320 #       include <sys/msg.h>
3321 #   endif
3322 #   ifdef HAS_SHM
3323 #       if defined(PERL_SCO) || defined(PERL_ISC)
3324 #           include <sys/sysmacros.h>   /* SHMLBA */
3325 #       endif
3326 #      include <sys/shm.h>
3327 #      ifndef HAS_SHMAT_PROTOTYPE
3328            extern Shmat_t shmat (int, char *, int);
3329 #      endif
3330 #      if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
3331 #          undef  SHMLBA /* not static: determined at boot time */
3332 #          define SHMLBA sysconf(_SC_PAGESIZE)
3333 #      elif defined(HAS_GETPAGESIZE)
3334 #          undef  SHMLBA /* not static: determined at boot time */
3335 #          define SHMLBA getpagesize()
3336 #      endif
3337 #   endif
3338 #endif
3339 EOFIX
3340                       $xs =~ s!
3341 #include <sys/types\.h>
3342 .*
3343 (#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms;
3344                       return $xs;
3345                   });
3346     }
3347 }
3348
3349 sub apply_fixups {
3350     my $fixups = shift;
3351     return unless $fixups;
3352     foreach my $file (@$fixups) {
3353         my $fh = open_or_die($file);
3354         my $line = <$fh>;
3355         close_or_die($fh);
3356         if ($line =~ /^#!perl\b/) {
3357             system $^X, $file
3358                 and die_255("$^X $file failed: \$!=$!, \$?=$?");
3359         } elsif ($line =~ /^#!(\/\S+)/) {
3360             system $file
3361                 and die_255("$file failed: \$!=$!, \$?=$?");
3362         } else {
3363             if (my ($target, $action, $pattern)
3364                 = $line =~ m#^(\S+) ([=!])~ /(.*)/#) {
3365                 if (length $pattern) {
3366                     next unless -f $target;
3367                     if ($action eq '=') {
3368                         next unless extract_from_file($target, $pattern);
3369                     } else {
3370                         next if extract_from_file($target, $pattern);
3371                     }
3372                 } else {
3373                     # Avoid the special case meaning of the empty pattern,
3374                     # and instead use this to simply test for the file being
3375                     # present or absent
3376                     if ($action eq '=') {
3377                         next unless -f $target;
3378                     } else {
3379                         next if -f $target;
3380                     }
3381                 }
3382             }
3383             system_or_die("patch -p1 <$file");
3384         }
3385     }
3386 }
3387
3388 # Local variables:
3389 # cperl-indent-level: 4
3390 # indent-tabs-mode: nil
3391 # End:
3392 #
3393 # ex: set ts=8 sts=4 sw=4 et: