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