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