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