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