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 unless(GetOptions(\%options,
  58                   'target=s', 'make=s', 'jobs|j=i', 'crash', 'expect-pass=i',
  59                   'expect-fail' => sub { $options{'expect-pass'} = 0; },
  60                   'clean!', 'one-liner|e=s@', 'c', 'l', 'w', 'match=s',
  61                   'no-match=s' => sub {
  62                       $options{match} = $_[1];
  63                       $options{'expect-pass'} = 0;
  64                   },
  65                   'force-manifest', 'force-regen', 'setpgrp!', 'timeout=i',
  66                   'test-build', 'validate',
  67                   'all-fixups', 'early-fixup=s@', 'late-fixup=s@', 'valgrind',
  68                   'check-args', 'check-shebang!', 'usage|help|?', 'gold=s',
  69                   'module=s', 'with-module=s', 'cpan-config-dir=s',
  70                   'test-module=s', 'no-module-tests',
  71                   'A=s@',
  72                   'D=s@' => sub {
  73                       my (undef, $val) = @_;
  74                       if ($val =~ /\A([^=]+)=(.*)/s) {
  75                           $defines{$1} = length $2 ? $2 : "\0";
  76                       } else {
  77                           $defines{$val} = '';
  78                       }
  79                   },
  80                   'U=s@' => sub {
  81                       $defines{$_[1]} = undef;
  82                   },
  83                  )) {
  84     pod2usage(exitval => 255, verbose => 1);
  85 }
  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<makedepend.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 When did perl start failing to build on a certain platform using C<g++> as the C-compiler?
 931
 932 =over 4
 933
 934 =item * Problem
 935
 936 On NetBSD-8.0, C<perl> had never been smoke-tested using C<g++> as the
 937 C-compiler.  Once this was done, it became evident that changes in that
 938 version of the operating system's code were incompatible with some C<perl>
 939 source written long before that OS version was ever released!
 940
 941 =item * Solution
 942
 943 Bisection range was first narrowed using existing builds at release tags.
 944 Then, bisection specified the C-compiler via C<Configure>-style switch and
 945 used C<--test-build> to identify the commit which "broke" the build.
 946
 947     .../perl Porting/bisect.pl \
 948         -Dcc=g++ \
 949         --test-build \
 950         --start=v5.21.6 \
 951         --end=v5.21.7
 952
 953 Then, problem was discussed with knowledgeable NetBSD user.
 954
 955 =item * Reference
 956
 957 L<GH issue 17381|https://github.com/Perl/perl5/issues/17381>
 958
 959 =back
 960
 961 =head2 When did a test file start to emit warnings?
 962
 963 =over 4
 964
 965 =item * Problem
 966
 967 When F<dist/Tie-File/t/43_synopsis> was run as part of C<make test>, we
 968 observed warnings not previously seen.  At what commit were those warnings
 969 first emitted?
 970
 971 =item * Solution
 972
 973 We know that when this test file was first committed to blead, no warnings
 974 were observed and there was no output to C<STDERR>.  So that commit becomes
 975 the value for C<--start>.
 976
 977 Since the test file in question is for a CPAN distribution maintained by core,
 978 we must prepare to run that test by including C<--target=test_prep> in the
 979 bisection invocation.  We then run the test file in a way that captures
 980 C<STDERR> in a file.  If that file has non-zero size, then we have presumably
 981 captured the newly seen warnings.
 982
 983     export ERR="/tmp/err"
 984
 985     .../perl Porting/bisect.pl \
 986       --start=507614678018ae1abd55a22e9941778c65741ba3 \
 987       --end=d34b46d077dcfc479c36f65b196086abd7941c76 \
 988       --target=test_prep \
 989       -e 'chdir("t");
 990         system(
 991           "./perl harness ../dist/Tie-File/t/43_synopsis.t
 992             2>$ENV{ERR}"
 993         );
 994         -s $ENV{ERR} and die "See $ENV{ERR} for warnings thrown";'
 995
 996 Bisection pointed to a commit where strictures and warnings were first turned
 997 on throughout the F<dist/Tie-File/> directory.
 998
 999 =item * Reference
1000
1001 L<Commit 125e1a3|https://github.com/Perl/perl5/commit/125e1a36a939>
1002
1003 =back
1004
1005 =cut
1006
1007 # Ensure we always exit with 255, to cause git bisect to abort.
1008 sub croak_255 {
1009     my $message = join '', @_;
1010     if ($message =~ /\n\z/) {
1011         print STDERR $message;
1012     } else {
1013         my (undef, $file, $line) = caller 1;
1014         print STDERR "@_ at $file line $line\n";
1015     }
1016     exit 255;
1017 }
1018
1019 sub die_255 {
1020     croak_255(@_);
1021 }
1022
1023 die_255("$0: Can't build $target")
1024     if defined $target && !grep {@targets} $target;
1025
1026 foreach my $phase (qw(early late)) {
1027     next unless $options{"$phase-fixup"};
1028     my $bail_out;
1029     require File::Glob;
1030     my @expanded;
1031     foreach my $glob (@{$options{"$phase-fixup"}}) {
1032         my @got = File::Glob::bsd_glob($glob);
1033         push @expanded, @got ? @got : $glob;
1034     }
1035     @expanded = sort @expanded;
1036     $options{"$phase-fixup"} = \@expanded;
1037     foreach (@expanded) {
1038         unless (-f $_) {
1039             print STDERR "$phase-fixup '$_' is not a readable file\n";
1040             ++$bail_out;
1041         }
1042     }
1043     exit 255 if $bail_out;
1044 }
1045
1046 unless (exists $defines{cc}) {
1047     # If it fails, the heuristic of 63f9ec3008baf7d6 is noisy, and hence
1048     # confusing.
1049     # FIXME - really it should be replaced with a proper test of
1050     # "can we build something?" and a helpful diagnostic if we can't.
1051     # For now, simply move it here.
1052     $defines{cc} = (`ccache -V`, $?) ? 'cc' : 'ccache cc';
1053 }
1054
1055 my $j = $options{jobs} ? "-j$options{jobs}" : '';
1056
1057 if (exists $options{make}) {
1058     if (!exists $defines{make}) {
1059         $defines{make} = $options{make};
1060     }
1061 } else {
1062     $options{make} = 'make';
1063 }
1064
1065 # Sadly, however hard we try, I don't think that it will be possible to build
1066 # modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29,
1067 # which updated to MakeMaker 3.7, which changed from using a hard coded ld
1068 # in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc.
1069
1070 sub open_or_die {
1071     my $file = shift;
1072     my $mode = @_ ? shift : '<';
1073     open my $fh, $mode, $file or croak_255("Can't open $file: $!");
1074     ${*$fh{SCALAR}} = $file;
1075     return $fh;
1076 }
1077
1078 sub close_or_die {
1079     my $fh = shift;
1080     return if close $fh;
1081     croak_255("Can't close: $!") unless ref $fh eq 'GLOB';
1082     croak_255("Can't close ${*$fh{SCALAR}}: $!");
1083 }
1084
1085 sub system_or_die {
1086     my $command = '</dev/null ' . shift;
1087     system($command) and croak_255("'$command' failed, \$!=$!, \$?=$?");
1088 }
1089
1090 sub run_with_options {
1091     my $options = shift;
1092     my $name = $options->{name};
1093     $name = "@_" unless defined $name;
1094
1095     my $setgrp = $options->{setpgrp};
1096     if ($options->{timeout}) {
1097         # Unless you explicitly disabled it on the commandline, set it:
1098         $setgrp = 1 unless defined $setgrp;
1099     }
1100     my $pid = fork;
1101     die_255("Can't fork: $!") unless defined $pid;
1102     if (!$pid) {
1103         if (exists $options->{stdin}) {
1104             open STDIN, '<', $options->{stdin}
1105               or die "Can't open STDIN from $options->{stdin}: $!";
1106         }
1107         if ($setgrp) {
1108             setpgrp 0, 0
1109                 or die "Can't setpgrp 0, 0: $!";
1110         }
1111         { exec @_ };
1112         die_255("Failed to start $name: $!");
1113     }
1114     my $start;
1115     if ($options->{timeout}) {
1116         require Errno;
1117         require POSIX;
1118         die_255("No POSIX::WNOHANG")
1119             unless &POSIX::WNOHANG;
1120         $start = time;
1121         $SIG{ALRM} = sub {
1122             my $victim = $setgrp ? -$pid : $pid;
1123             my $delay = 1;
1124             kill 'TERM', $victim;
1125             waitpid(-1, &POSIX::WNOHANG);
1126             while (kill 0, $victim) {
1127                 sleep $delay;
1128                 waitpid(-1, &POSIX::WNOHANG);
1129                 $delay *= 2;
1130                 if ($delay > 8) {
1131                     if (kill 'KILL', $victim) {
1132                         print STDERR "$0: Had to kill 'KILL', $victim\n"
1133                     } elsif (! $!{ESRCH}) {
1134                         print STDERR "$0: kill 'KILL', $victim failed: $!\n";
1135                     }
1136                     last;
1137                 }
1138             }
1139             report_and_exit(0, 'No timeout', 'Timeout', "when running $name");
1140         };
1141         alarm $options->{timeout};
1142     }
1143     waitpid $pid, 0
1144       or die_255("wait for $name, pid $pid failed: $!");
1145     alarm 0;
1146     if ($options->{timeout}) {
1147         my $elapsed = time - $start;
1148         if ($elapsed / $options->{timeout} > 0.8) {
1149             print STDERR "$0: Beware, took $elapsed seconds of $options->{timeout} permitted to run $name\n";
1150         }
1151     }
1152     return $?;
1153 }
1154
1155 sub extract_from_file {
1156     my ($file, $rx, $default) = @_;
1157     my $fh = open_or_die($file);
1158     while (<$fh>) {
1159         my @got = $_ =~ $rx;
1160         return wantarray ? @got : $got[0]
1161             if @got;
1162     }
1163     return $default if defined $default;
1164     return;
1165 }
1166
1167 sub edit_file {
1168     my ($file, $munger) = @_;
1169     local $/;
1170     my $fh = open_or_die($file);
1171     my $orig = <$fh>;
1172     die_255("Can't read $file: $!") unless defined $orig && close $fh;
1173     my $new = $munger->($orig);
1174     return if $new eq $orig;
1175     $fh = open_or_die($file, '>');
1176     print $fh $new or die_255("Can't print to $file: $!");
1177     close_or_die($fh);
1178 }
1179
1180 # AIX supplies a pre-historic patch program, which certainly predates Linux
1181 # and is probably older than NT. It can't cope with unified diffs. Meanwhile,
1182 # it's hard enough to get git diff to output context diffs, let alone git show,
1183 # and nearly all the patches embedded here are unified. So it seems that the
1184 # path of least resistance is to convert unified diffs to context diffs:
1185
1186 sub process_hunk {
1187     my ($from_out, $to_out, $has_from, $has_to, $delete, $add) = @_;
1188     ++$$has_from if $delete;
1189     ++$$has_to if $add;
1190
1191     if ($delete && $add) {
1192         $$from_out .= "! $_\n" foreach @$delete;
1193         $$to_out .= "! $_\n" foreach @$add;
1194     } elsif ($delete) {
1195         $$from_out .= "- $_\n" foreach @$delete;
1196     } elsif ($add) {
1197          $$to_out .= "+ $_\n" foreach @$add;
1198     }
1199 }
1200
1201 # This isn't quite general purpose, as it can't cope with
1202 # '\ No newline at end of file'
1203 sub ud2cd {
1204     my $diff_in = shift;
1205     my $diff_out = '';
1206
1207     # Stuff before the diff
1208     while ($diff_in =~ s/\A(?!\*\*\* )(?!--- )([^\n]*\n?)//ms && length $1) {
1209         $diff_out .= $1;
1210     }
1211
1212     if (!length $diff_in) {
1213         die_255("That didn't seem to be a diff");
1214     }
1215
1216     if ($diff_in =~ /\A\*\*\* /ms) {
1217         warn "Seems to be a context diff already\n";
1218         return $diff_out . $diff_in;
1219     }
1220
1221     # Loop for files
1222  FILE: while (1) {
1223         if ($diff_in =~ s/\A((?:diff |index )[^\n]+\n)//ms) {
1224             $diff_out .= $1;
1225             next;
1226         }
1227         if ($diff_in !~ /\A--- /ms) {
1228             # Stuff after the diff;
1229             return $diff_out . $diff_in;
1230         }
1231         $diff_in =~ s/\A([^\n]+\n?)//ms;
1232         my $line = $1;
1233         die_255("Can't parse '$line'") unless $line =~ s/\A--- /*** /ms;
1234         $diff_out .= $line;
1235         $diff_in =~ s/\A([^\n]+\n?)//ms;
1236         $line = $1;
1237         die_255("Can't parse '$line'") unless $line =~ s/\A\+\+\+ /--- /ms;
1238         $diff_out .= $line;
1239
1240         # Loop for hunks
1241         while (1) {
1242             next FILE
1243                 unless $diff_in =~ s/\A\@\@ (-([0-9]+),([0-9]+) \+([0-9]+),([0-9]+)) \@\@[^\n]*\n?//;
1244             my ($hunk, $from_start, $from_count, $to_start, $to_count)
1245                 = ($1, $2, $3, $4, $5);
1246             my $from_end = $from_start + $from_count - 1;
1247             my $to_end = $to_start + $to_count - 1;
1248             my ($from_out, $to_out, $has_from, $has_to, $add, $delete);
1249             while (length $diff_in && ($from_count || $to_count)) {
1250                 die_255("Confused in $hunk")
1251                     unless $diff_in =~ s/\A([^\n]*)\n//ms;
1252                 my $line = $1;
1253                 $line = ' ' unless length $line;
1254                 if ($line =~ /^ .*/) {
1255                     process_hunk(\$from_out, \$to_out, \$has_from, \$has_to,
1256                                  $delete, $add);
1257                     undef $delete;
1258                     undef $add;
1259                     $from_out .= " $line\n";
1260                     $to_out .= " $line\n";
1261                     --$from_count;
1262                     --$to_count;
1263                 } elsif ($line =~ /^-(.*)/) {
1264                     push @$delete, $1;
1265                     --$from_count;
1266                 } elsif ($line =~ /^\+(.*)/) {
1267                     push @$add, $1;
1268                     --$to_count;
1269                 } else {
1270                     die_255("Can't parse '$line' as part of hunk $hunk");
1271                 }
1272             }
1273             process_hunk(\$from_out, \$to_out, \$has_from, \$has_to,
1274                          $delete, $add);
1275             die_255("No lines in hunk $hunk")
1276                 unless length $from_out || length $to_out;
1277             die_255("No changes in hunk $hunk")
1278                 unless $has_from || $has_to;
1279             $diff_out .= "***************\n";
1280             $diff_out .= "*** $from_start,$from_end ****\n";
1281             $diff_out .= $from_out if $has_from;
1282             $diff_out .= "--- $to_start,$to_end ----\n";
1283             $diff_out .= $to_out if $has_to;
1284         }
1285     }
1286 }
1287
1288 {
1289     my $use_context;
1290
1291     sub placate_patch_prog {
1292         my $patch = shift;
1293
1294         if (!defined $use_context) {
1295             my $version = `patch -v 2>&1`;
1296             die_255("Can't run `patch -v`, \$?=$?, bailing out")
1297                 unless defined $version;
1298             if ($version =~ /Free Software Foundation/) {
1299                 $use_context = 0;
1300             } elsif ($version =~ /Header: patch\.c,v.*\blwall\b/) {
1301                 # The system patch is older than Linux, and probably older than
1302                 # Windows NT.
1303                 $use_context = 1;
1304             } elsif ($version =~ /Header: patch\.c,v.*\babhinav\b/) {
1305                 # Thank you HP. No, we have no idea *which* version this is:
1306                 # $Header: patch.c,v 76.1.1.2.1.3 2001/12/03 12:24:52 abhinav Exp $
1307                 $use_context = 1;
1308             } else {
1309                 # Don't know.
1310                 $use_context = 0;
1311             }
1312         }
1313
1314         return $use_context ? ud2cd($patch) : $patch;
1315     }
1316 }
1317
1318 sub apply_patch {
1319     my ($patch, $what, $files) = @_;
1320     $what = 'patch' unless defined $what;
1321     unless (defined $files) {
1322         $patch =~ m!^--- [ab]/(\S+)\n\+\+\+ [ba]/\1!sm;
1323         $files = " $1";
1324     }
1325     my $patch_to_use = placate_patch_prog($patch);
1326     open my $fh, '|-', 'patch', '-p1' or die_255("Can't run patch: $!");
1327     print $fh $patch_to_use;
1328     return if close $fh;
1329     print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n";
1330     print STDERR "\nConverted to a context diff <<'EOCONTEXT'\n${patch_to_use}EOCONTEXT\n"
1331         if $patch_to_use ne $patch;
1332     die_255("Can't $what$files: $?, $!");
1333 }
1334
1335 sub apply_commit {
1336     my ($commit, @files) = @_;
1337     my $patch = `git show $commit @files`;
1338     if (!defined $patch) {
1339         die_255("Can't get commit $commit for @files: $?") if @files;
1340         die_255("Can't get commit $commit: $?");
1341     }
1342     apply_patch($patch, "patch $commit", @files ? " for @files" : '');
1343 }
1344
1345 sub revert_commit {
1346     my ($commit, @files) = @_;
1347     my $patch = `git show -R $commit @files`;
1348     if (!defined $patch) {
1349         die_255("Can't get revert commit $commit for @files: $?") if @files;
1350         die_255("Can't get revert commit $commit: $?");
1351     }
1352     apply_patch($patch, "revert $commit", @files ? " for @files" : '');
1353 }
1354
1355 sub checkout_file {
1356     my ($file, $commit) = @_;
1357     $commit ||= $options{gold} || 'blead';
1358     system "git show $commit:$file > $file </dev/null"
1359         and die_255("Could not extract $file at revision $commit");
1360 }
1361
1362 sub check_shebang {
1363     my $file = shift;
1364     return unless -e $file;
1365     my $fh = open_or_die($file);
1366     my $line = <$fh>;
1367     return if $line =~ $run_with_our_perl;
1368     if (!-x $file) {
1369         die_255("$file is not executable.
1370 system($file, ...) is always going to fail.
1371
1372 Bailing out");
1373     }
1374     return unless $line =~ m{\A#!(/\S+/perl\S*)\s};
1375     die_255("$file will always be run by $1
1376 It won't be tested by the ./perl we build.
1377 If you intended to run it with that perl binary, please change your
1378 test case to
1379
1380     $1 @ARGV
1381
1382 If you intended to test it with the ./perl we build, please change your
1383 test case to
1384
1385     ./perl -Ilib @ARGV
1386
1387 [You may also need to add -- before ./perl to prevent that -Ilib as being
1388 parsed as an argument to bisect.pl]
1389
1390 Bailing out");
1391 }
1392
1393 sub clean {
1394     if ($options{clean}) {
1395         # Needed, because files that are build products in this checked out
1396         # version might be in git in the next desired version.
1397         system 'git clean -qdxf </dev/null';
1398         # Needed, because at some revisions the build alters checked out files.
1399         # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
1400         system 'git reset --hard HEAD </dev/null';
1401     }
1402 }
1403
1404 sub skip {
1405     my $reason = shift;
1406     clean();
1407     warn "skipping - $reason";
1408     exit 125;
1409 }
1410
1411 sub report_and_exit {
1412     my ($good, $pass, $fail, $desc) = @_;
1413
1414     clean();
1415
1416     my $got = ($options{'expect-pass'} ? $good : !$good) ? 'good' : 'bad';
1417     if ($good) {
1418         print "$got - $pass $desc\n";
1419     } else {
1420         print "$got - $fail $desc\n";
1421     }
1422
1423     exit($got eq 'bad');
1424 }
1425
1426 sub run_report_and_exit {
1427     my $ret = run_with_options({setprgp => $options{setpgrp},
1428                                 timeout => $options{timeout},
1429                                }, @_);
1430     $ret &= 0xff if $options{crash};
1431     report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_");
1432 }
1433
1434 sub match_and_exit {
1435     my ($target, @globs) = @_;
1436     my $matches = 0;
1437     my $re = qr/$match/;
1438     my @files;
1439
1440     if (@globs) {
1441         require File::Glob;
1442         foreach (sort map { File::Glob::bsd_glob($_)} @globs) {
1443             if (!-f $_ || !-r _) {
1444                 warn "Skipping matching '$_' as it is not a readable file\n";
1445             } else {
1446                 push @files, $_;
1447             }
1448         }
1449     } else {
1450         local $/ = "\0";
1451         @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`;
1452         chomp @files;
1453     }
1454
1455     foreach my $file (@files) {
1456         my $fh = open_or_die($file);
1457         while (<$fh>) {
1458             if ($_ =~ $re) {
1459                 ++$matches;
1460                 if (/[^[:^cntrl:]\h\v]/) { # Matches non-spacing non-C1 controls
1461                     print "Binary file $file matches\n";
1462                 } else {
1463                     $_ .= "\n" unless /\n\z/;
1464                     print "$file: $_";
1465                 }
1466             }
1467         }
1468         close_or_die($fh);
1469     }
1470     report_and_exit($matches,
1471                     $matches == 1 ? '1 match for' : "$matches matches for",
1472                     'no matches for', $match);
1473 }
1474
1475 # Not going to assume that system perl is yet new enough to have autodie
1476 system_or_die('git clean -dxf');
1477
1478 if (!defined $target) {
1479     match_and_exit(undef, @ARGV) if $match;
1480     $target = 'test_prep';
1481 } elsif ($target eq 'none') {
1482     match_and_exit(undef, @ARGV) if $match;
1483     run_report_and_exit(@ARGV);
1484 }
1485
1486 skip('no Configure - is this the //depot/perlext/Compiler branch?')
1487     unless -f 'Configure';
1488
1489 my $case_insensitive;
1490 {
1491     my ($dev_C, $ino_C) = stat 'Configure';
1492     die_255("Could not stat Configure: $!") unless defined $dev_C;
1493     my ($dev_c, $ino_c) = stat 'configure';
1494     ++$case_insensitive
1495         if defined $dev_c && $dev_C == $dev_c && $ino_C == $ino_c;
1496 }
1497
1498 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
1499 my $major
1500     = extract_from_file('patchlevel.h',
1501                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
1502                         0);
1503
1504 my $unfixable_db_file;
1505
1506 if ($major < 10
1507     && !extract_from_file('ext/DB_File/DB_File.xs',
1508                           qr!^#else /\* Berkeley DB Version > 2 \*/$!)) {
1509     # This DB_File.xs is really too old to patch up.
1510     # Skip DB_File, unless we're invoked with an explicit -Unoextensions
1511     if (!exists $defines{noextensions}) {
1512         $defines{noextensions} = 'DB_File';
1513     } elsif (defined $defines{noextensions}) {
1514         $defines{noextensions} .= ' DB_File';
1515     }
1516     ++$unfixable_db_file;
1517 }
1518
1519 patch_Configure();
1520 patch_hints();
1521 if ($options{'all-fixups'}) {
1522     patch_SH();
1523     patch_C();
1524     patch_ext();
1525 }
1526 apply_fixups($options{'early-fixup'});
1527
1528 # if Encode is not needed for the test, you can speed up the bisect by
1529 # excluding it from the runs with -Dnoextensions=Encode
1530 # ccache is an easy win. Remove it if it causes problems.
1531 # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
1532 # to true in hints/linux.sh
1533 # On dromedary, from that point on, Configure (by default) fails to find any
1534 # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
1535 # versioned libraries. Without -lm, the build fails.
1536 # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
1537 # until commit faae14e6e968e1c0 adds it to the hints.
1538 # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
1539 # because it will spot versioned libraries, pass them to the compiler, and then
1540 # bail out pretty early on. Configure won't let us override libswanted, but it
1541 # will let us override the entire libs list.
1542
1543 foreach (@{$options{A}}) {
1544     push @paths, $1 if /^libpth=(.*)/s;
1545 }
1546
1547 unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
1548     # Before 1cfa4ec74d4933da, so force the libs list.
1549
1550     my @libs;
1551     # This is the current libswanted list from Configure, less the libs removed
1552     # by current hints/linux.sh
1553     foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl
1554                         ld sun m crypt sec util c cposix posix ucb BSD)) {
1555         foreach my $dir (@paths) {
1556             # Note the wonderful consistency of dot-or-not in the config vars:
1557             next unless -f "$dir/lib$lib.$Config{dlext}"
1558                 || -f "$dir/lib$lib$Config{lib_ext}";
1559             push @libs, "-l$lib";
1560             last;
1561         }
1562     }
1563     $defines{libs} = \@libs unless exists $defines{libs};
1564 }
1565
1566 $defines{usenm} = undef
1567     if $major < 2 && !exists $defines{usenm};
1568
1569 my ($missing, $created_dirs);
1570 ($missing, $created_dirs) = force_manifest()
1571     if $options{'force-manifest'};
1572
1573 my @ARGS = '-dEs';
1574 foreach my $key (sort keys %defines) {
1575     my $val = $defines{$key};
1576     if (ref $val) {
1577         push @ARGS, "-D$key=@$val";
1578     } elsif (!defined $val) {
1579         push @ARGS, "-U$key";
1580     } elsif (!length $val) {
1581         push @ARGS, "-D$key";
1582     } else {
1583         $val = "" if $val eq "\0";
1584         push @ARGS, "-D$key=$val";
1585     }
1586 }
1587 push @ARGS, map {"-A$_"} @{$options{A}};
1588
1589 my $prefix;
1590
1591 # Testing a module? We need to install perl/cpan modules to a temp dir
1592 if ($options{module} || $options{'with-module'} || $options{'test-module'})
1593 {
1594   $prefix = tempdir(CLEANUP => 1);
1595
1596   push @ARGS, "-Dprefix=$prefix";
1597   push @ARGS, "-Uversiononly", "-Dinstallusrbinperl=n";
1598 }
1599
1600 # If a file in MANIFEST is missing, Configure asks if you want to
1601 # continue (the default being 'n'). With stdin closed or /dev/null,
1602 # it exits immediately and the check for config.sh below will skip.
1603 # Without redirecting stdin, the commands called will attempt to read from
1604 # stdin (and thus effectively hang)
1605 run_with_options({stdin => '/dev/null', name => 'Configure'},
1606                  './Configure', @ARGS);
1607
1608 patch_SH() unless $options{'all-fixups'};
1609 apply_fixups($options{'late-fixup'});
1610
1611 if (-f 'config.sh') {
1612     # Emulate noextensions if Configure doesn't support it.
1613     fake_noextensions()
1614         if $major < 10 && $defines{noextensions};
1615     if (system './Configure -S') {
1616         # See commit v5.23.5-89-g7a4fcb3.  Configure may try to run
1617         # ./optdef.sh instead of UU/optdef.sh.  Copying the file is
1618         # easier than patching Configure (which mentions optdef.sh multi-
1619         # ple times).
1620         require File::Copy;
1621         File::Copy::copy("UU/optdef.sh", "./optdef.sh");
1622         system_or_die('./Configure -S');
1623     }
1624 }
1625
1626 if ($target =~ /config\.s?h/) {
1627     match_and_exit($target, @ARGV) if $match && -f $target;
1628     report_and_exit(-f $target, 'could build', 'could not build', $target)
1629         if $options{'test-build'};
1630
1631     skip("could not build $target") unless -f $target;
1632
1633     run_report_and_exit(@ARGV);
1634 } elsif (!-f 'config.sh') {
1635     # Skip if something went wrong with Configure
1636
1637     skip('could not build config.sh');
1638 }
1639
1640 force_manifest_cleanup($missing, $created_dirs)
1641         if $missing;
1642
1643 if($options{'force-regen'}
1644    && extract_from_file('Makefile', qr/\bregen_headers\b/)) {
1645     # regen_headers was added in e50aee73b3d4c555, patch.1m for perl5.001
1646     # It's not worth faking it for earlier revisions.
1647     system_or_die('make regen_headers');
1648 }
1649
1650 unless ($options{'all-fixups'}) {
1651     patch_C();
1652     patch_ext();
1653 }
1654
1655 # Parallel build for miniperl is safe
1656 system "$options{make} $j miniperl </dev/null";
1657
1658 # This is the file we expect make to create
1659 my $expected_file = $target =~ /^test/ ? 't/perl'
1660     : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}"
1661     : $target;
1662 # This is the target we tell make to build in order to get $expected_file
1663 my $real_target = $target eq 'Fcntl' ? $expected_file : $target;
1664
1665 if ($target ne 'miniperl') {
1666     # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
1667     $j = '' if $major < 10;
1668
1669     if ($real_target eq 'test_prep') {
1670         if ($major < 8) {
1671             # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
1672             # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
1673             # earlier than that, just make test. It will be fast enough.
1674             $real_target = extract_from_file('Makefile.SH',
1675                                              qr/^(test[-_]prep):/,
1676                                              'test');
1677         }
1678     }
1679
1680     system "$options{make} $j $real_target </dev/null";
1681 }
1682
1683 my $expected_file_found = $expected_file =~ /perl$/
1684     ? -x $expected_file : -r $expected_file;
1685
1686 if ($expected_file_found && $expected_file eq 't/perl') {
1687     # Check that it isn't actually pointing to ../miniperl, which will happen
1688     # if the sanity check ./miniperl -Ilib -MExporter -e '<?>' fails, and
1689     # Makefile tries to run minitest.
1690
1691     # Of course, helpfully sometimes it's called ../perl, other times .././perl
1692     # and who knows if that list is exhaustive...
1693     my ($dev0, $ino0) = stat 't/perl';
1694     my ($dev1, $ino1) = stat 'perl';
1695     unless (defined $dev0 && defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1) {
1696         undef $expected_file_found;
1697         my $link = readlink $expected_file;
1698         warn "'t/perl' => '$link', not 'perl'";
1699         die_255("Could not realink t/perl: $!") unless defined $link;
1700     }
1701 }
1702
1703 my $just_testing = 0;
1704
1705 if ($options{'test-build'}) {
1706     report_and_exit($expected_file_found, 'could build', 'could not build',
1707                     $real_target);
1708 } elsif (!$expected_file_found) {
1709     skip("could not build $real_target");
1710 } elsif (my $mod_opt = $options{module} || $options{'with-module'}
1711                || ($just_testing++, $options{'test-module'})) {
1712   # Testing a cpan module? See if it will install
1713   # First we need to install this perl somewhere
1714   system_or_die('./installperl');
1715
1716   my @m = split(',', $mod_opt);
1717
1718   my $bdir = File::Temp::tempdir(
1719     CLEANUP => 1,
1720   ) or die $!;
1721
1722   # Don't ever stop to ask the user for input
1723   $ENV{AUTOMATED_TESTING} = 1;
1724   $ENV{PERL_MM_USE_DEFAULT} = 1;
1725
1726   # Don't let these interfere with our cpan installs
1727   delete $ENV{PERL_MB_OPT};
1728   delete $ENV{PERL_MM_OPT};
1729
1730   # Make sure we load up our CPAN::MyConfig and then
1731   # override the build_dir so we have a fresh one
1732   # every build
1733   my $cdir = $options{'cpan-config-dir'}
1734           || File::Spec->catfile($ENV{HOME},".cpan");
1735
1736   my @cpanshell = (
1737     "$prefix/bin/perl",
1738     "-I", "$cdir",
1739     "-MCPAN::MyConfig",
1740     "-MCPAN",
1741     "-e","\$CPAN::Config->{build_dir}=q{$bdir};",
1742     "-e",
1743   );
1744
1745   for (@m) {
1746     s/-/::/g if /-/ and !m|/|;
1747   }
1748   my $install = join ",", map { "'$_'" } @m;
1749   if ($just_testing) {
1750     $install = "test($install)";
1751   } elsif ($options{'no-module-tests'}) {
1752     $install = "notest('install',$install)";
1753   } else {
1754     $install = "install($install)";
1755   }
1756   my $last = $m[-1];
1757   my $status_method = $just_testing ? 'test' : 'uptodate';
1758   my $shellcmd = "$install; die unless CPAN::Shell->expand(Module => '$last')->$status_method;";
1759
1760   if ($options{module} || $options{'test-module'}) {
1761     run_report_and_exit(@cpanshell, $shellcmd);
1762   } else {
1763     my $ret = run_with_options({setprgp => $options{setpgrp},
1764                                 timeout => $options{timeout},
1765                                }, @cpanshell, $shellcmd);
1766     $ret &= 0xff if $options{crash};
1767
1768     # Failed? Give up
1769     if ($ret) {
1770       report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_");
1771     }
1772   }
1773 }
1774
1775 match_and_exit($real_target, @ARGV) if $match;
1776
1777 if (defined $options{'one-liner'}) {
1778     my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl';
1779     unshift @ARGV, map {('-e', $_)} @{$options{'one-liner'}};
1780     foreach (qw(c l w)) {
1781         unshift @ARGV, "-$_" if $options{$_};
1782     }
1783     unshift @ARGV, "./$exe", '-Ilib';
1784 }
1785
1786 if (-f $ARGV[0]) {
1787     my $fh = open_or_die($ARGV[0]);
1788     my $line = <$fh>;
1789     unshift @ARGV, $1, '-Ilib'
1790         if $line =~ $run_with_our_perl;
1791 }
1792
1793 if ($options{valgrind}) {
1794     # Turns out to be too confusing to use an optional argument with the path
1795     # of the valgrind binary, as if --valgrind takes an optional argument,
1796     # then specifying it as the last option eats the first part of the testcase.
1797     # ie this: .../bisect.pl --valgrind testcase
1798     # is treated as --valgrind=testcase and as there is no test case given,
1799     # it's an invalid commandline, bailing out with the usage message.
1800
1801     # Currently, the test script can't signal a skip with 125, so anything
1802     # non-zero would do. But to keep that option open in future, use 124
1803     unshift @ARGV, 'valgrind', '--error-exitcode=124';
1804 }
1805
1806 # This is what we came here to run:
1807
1808 if (exists $Config{ldlibpthname}) {
1809     require Cwd;
1810     my $varname = $Config{ldlibpthname};
1811     my $cwd = Cwd::getcwd();
1812     if (defined $ENV{$varname}) {
1813         $ENV{$varname} = $cwd . $Config{path_sep} . $ENV{$varname};
1814     } else {
1815         $ENV{$varname} = $cwd;
1816     }
1817 }
1818
1819 run_report_and_exit(@ARGV);
1820
1821 ############################################################################
1822 #
1823 # Patching, editing and faking routines only below here.
1824 #
1825 ############################################################################
1826
1827 sub fake_noextensions {
1828     edit_file('config.sh', sub {
1829                   my @lines = split /\n/, shift;
1830                   my @ext = split /\s+/, $defines{noextensions};
1831                   foreach (@lines) {
1832                       next unless /^extensions=/ || /^dynamic_ext/;
1833                       foreach my $ext (@ext) {
1834                           s/\b$ext( )?\b/$1/;
1835                       }
1836                   }
1837                   return join "\n", @lines;
1838               });
1839 }
1840
1841 sub force_manifest {
1842     my (@missing, @created_dirs);
1843     my $fh = open_or_die('MANIFEST');
1844     while (<$fh>) {
1845         next unless /^(\S+)/;
1846         # -d is special case needed (at least) between 27332437a2ed1941 and
1847         # bf3d9ec563d25054^ inclusive, as manifest contains ext/Thread/Thread
1848         push @missing, $1
1849             unless -f $1 || -d $1;
1850     }
1851     close_or_die($fh);
1852
1853     foreach my $pathname (@missing) {
1854         my @parts = split '/', $pathname;
1855         my $leaf = pop @parts;
1856         my $path = '.';
1857         while (@parts) {
1858             $path .= '/' . shift @parts;
1859             next if -d $path;
1860             mkdir $path, 0700 or die_255("Can't create $path: $!");
1861             unshift @created_dirs, $path;
1862         }
1863         $fh = open_or_die($pathname, '>');
1864         close_or_die($fh);
1865         chmod 0, $pathname or die_255("Can't chmod 0 $pathname: $!");
1866     }
1867     return \@missing, \@created_dirs;
1868 }
1869
1870 sub force_manifest_cleanup {
1871     my ($missing, $created_dirs) = @_;
1872     # This is probably way too paranoid:
1873     my @errors;
1874     require Fcntl;
1875     foreach my $file (@$missing) {
1876         my (undef, undef, $mode, undef, undef, undef, undef, $size)
1877             = stat $file;
1878         if (!defined $mode) {
1879             push @errors, "Added file $file has been deleted by Configure";
1880             next;
1881         }
1882         if (Fcntl::S_IMODE($mode) != 0) {
1883             push @errors,
1884                 sprintf 'Added file %s had mode changed by Configure to %03o',
1885                     $file, $mode;
1886         }
1887         if ($size != 0) {
1888             push @errors,
1889                 "Added file $file had sized changed by Configure to $size";
1890         }
1891         unlink $file or die_255("Can't unlink $file: $!");
1892     }
1893     foreach my $dir (@$created_dirs) {
1894         rmdir $dir or die_255("Can't rmdir $dir: $!");
1895     }
1896     skip("@errors")
1897         if @errors;
1898 }
1899
1900 sub patch_Configure {
1901     if ($major < 1) {
1902         if (extract_from_file('Configure',
1903                               qr/^\t\t\*=\*\) echo "\$1" >> \$optdef;;$/)) {
1904             # This is "        Spaces now allowed in -D command line options.",
1905             # part of commit ecfc54246c2a6f42
1906             apply_patch(<<'EOPATCH');
1907 diff --git a/Configure b/Configure
1908 index 3d3b38d..78ffe16 100755
1909 --- a/Configure
1910 +++ b/Configure
1911 @@ -652,7 +777,8 @@ while test $# -gt 0; do
1912                         echo "$me: use '-U symbol=', not '-D symbol='." >&2
1913                         echo "$me: ignoring -D $1" >&2
1914                         ;;
1915 -               *=*) echo "$1" >> $optdef;;
1916 +               *=*) echo "$1" | \
1917 +                               sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;;
1918                 *) echo "$1='define'" >> $optdef;;
1919                 esac
1920                 shift
1921 EOPATCH
1922         }
1923
1924         if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) {
1925             # Configure's original simple "grep" for d_namlen falls foul of the
1926             # approach taken by the glibc headers:
1927             # #ifdef _DIRENT_HAVE_D_NAMLEN
1928             # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen)
1929             #
1930             # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux.
1931             # This is also part of commit ecfc54246c2a6f42
1932             apply_patch(<<'EOPATCH');
1933 diff --git a/Configure b/Configure
1934 index 3d3b38d..78ffe16 100755
1935 --- a/Configure
1936 +++ b/Configure
1937 @@ -3935,7 +4045,8 @@ $rm -f try.c
1938
1939  : see if the directory entry stores field length
1940  echo " "
1941 -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
1942 +$cppstdin $cppflags $cppminus < "$xinc" > try.c
1943 +if $contains 'd_namlen' try.c >/dev/null 2>&1; then
1944         echo "Good, your directory entry keeps length information in d_namlen." >&4
1945         val="$define"
1946  else
1947 EOPATCH
1948         }
1949     }
1950
1951     if ($major < 2
1952         && !extract_from_file('Configure',
1953                               qr/Try to guess additional flags to pick up local libraries/)) {
1954         my $mips = extract_from_file('Configure',
1955                                      qr!(''\) if (?:\./)?mips; then)!);
1956         # This is part of perl-5.001n. It's needed, to add -L/usr/local/lib to
1957         # the ld flags if libraries are found there. It shifts the code to set
1958         # up libpth earlier, and then adds the code to add libpth entries to
1959         # ldflags
1960         # mips was changed to ./mips in ecfc54246c2a6f42, perl5.000 patch.0g
1961         apply_patch(sprintf <<'EOPATCH', $mips);
1962 diff --git a/Configure b/Configure
1963 index 53649d5..0635a6e 100755
1964 --- a/Configure
1965 +++ b/Configure
1966 @@ -2749,6 +2749,52 @@ EOM
1967         ;;
1968  esac
1969
1970 +: Set private lib path
1971 +case "$plibpth" in
1972 +'') if ./mips; then
1973 +               plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
1974 +       fi;;
1975 +esac
1976 +case "$libpth" in
1977 +' ') dlist='';;
1978 +'') dlist="$plibpth $glibpth";;
1979 +*) dlist="$libpth";;
1980 +esac
1981 +
1982 +: Now check and see which directories actually exist, avoiding duplicates
1983 +libpth=''
1984 +for xxx in $dlist
1985 +do
1986 +    if $test -d $xxx; then
1987 +               case " $libpth " in
1988 +               *" $xxx "*) ;;
1989 +               *) libpth="$libpth $xxx";;
1990 +               esac
1991 +    fi
1992 +done
1993 +$cat <<'EOM'
1994 +
1995 +Some systems have incompatible or broken versions of libraries.  Among
1996 +the directories listed in the question below, please remove any you
1997 +know not to be holding relevant libraries, and add any that are needed.
1998 +Say "none" for none.
1999 +
2000 +EOM
2001 +case "$libpth" in
2002 +'') dflt='none';;
2003 +*)
2004 +       set X $libpth
2005 +       shift
2006 +       dflt=${1+"$@"}
2007 +       ;;
2008 +esac
2009 +rp="Directories to use for library searches?"
2010 +. ./myread
2011 +case "$ans" in
2012 +none) libpth=' ';;
2013 +*) libpth="$ans";;
2014 +esac
2015 +
2016  : flags used in final linking phase
2017  case "$ldflags" in
2018  '') if ./venix; then
2019 @@ -2765,6 +2811,23 @@ case "$ldflags" in
2020         ;;
2021  *) dflt="$ldflags";;
2022  esac
2023 +
2024 +: Possible local library directories to search.
2025 +loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib"
2026 +loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib"
2027 +
2028 +: Try to guess additional flags to pick up local libraries.
2029 +for thislibdir in $libpth; do
2030 +       case " $loclibpth " in
2031 +       *" $thislibdir "*)
2032 +               case "$dflt " in
2033 +               "-L$thislibdir ") ;;
2034 +               *)  dflt="$dflt -L$thislibdir" ;;
2035 +               esac
2036 +               ;;
2037 +       esac
2038 +done
2039 +
2040  echo " "
2041  rp="Any additional ld flags (NOT including libraries)?"
2042  . ./myread
2043 @@ -2828,52 +2891,6 @@ n) echo "OK, that should do.";;
2044  esac
2045  $rm -f try try.* core
2046
2047 -: Set private lib path
2048 -case "$plibpth" in
2049 -%s
2050 -               plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
2051 -       fi;;
2052 -esac
2053 -case "$libpth" in
2054 -' ') dlist='';;
2055 -'') dlist="$plibpth $glibpth";;
2056 -*) dlist="$libpth";;
2057 -esac
2058 -
2059 -: Now check and see which directories actually exist, avoiding duplicates
2060 -libpth=''
2061 -for xxx in $dlist
2062 -do
2063 -    if $test -d $xxx; then
2064 -               case " $libpth " in
2065 -               *" $xxx "*) ;;
2066 -               *) libpth="$libpth $xxx";;
2067 -               esac
2068 -    fi
2069 -done
2070 -$cat <<'EOM'
2071 -
2072 -Some systems have incompatible or broken versions of libraries.  Among
2073 -the directories listed in the question below, please remove any you
2074 -know not to be holding relevant libraries, and add any that are needed.
2075 -Say "none" for none.
2076 -
2077 -EOM
2078 -case "$libpth" in
2079 -'') dflt='none';;
2080 -*)
2081 -       set X $libpth
2082 -       shift
2083 -       dflt=${1+"$@"}
2084 -       ;;
2085 -esac
2086 -rp="Directories to use for library searches?"
2087 -. ./myread
2088 -case "$ans" in
2089 -none) libpth=' ';;
2090 -*) libpth="$ans";;
2091 -esac
2092 -
2093  : compute shared library extension
2094  case "$so" in
2095  '')
2096 EOPATCH
2097     }
2098
2099     if ($major == 4 && extract_from_file('Configure', qr/^d_gethbynam=/)) {
2100         # Fixes a bug introduced in 4599a1dedd47b916
2101         apply_commit('3cbc818d1d0ac470');
2102     }
2103
2104     if ($major == 4 && extract_from_file('Configure',
2105                                          qr/gethbadd_addr_type=`echo \$gethbadd_addr_type/)) {
2106         # Fixes a bug introduced in 3fd537d4b944bc7a
2107         apply_commit('6ff9219da6cf8cfd');
2108     }
2109
2110     if ($major == 4 && extract_from_file('Configure',
2111                                          qr/^pthreads_created_joinable=/)) {
2112         # Fix for bug introduced in 52e1cb5ebf5e5a8c
2113         # Part of commit ce637636a41b2fef
2114         edit_file('Configure', sub {
2115                       my $code = shift;
2116                       $code =~ s{^pthreads_created_joinable=''}
2117                                 {d_pthreads_created_joinable=''}ms
2118                                     or die_255("Substitution failed");
2119                       $code =~ s{^pthreads_created_joinable='\$pthreads_created_joinable'}
2120                                 {d_pthreads_created_joinable='\$d_pthreads_created_joinable'}ms
2121                            or die_255("Substitution failed");
2122                       return $code;
2123                   });
2124     }
2125
2126     if ($major < 5 && extract_from_file('Configure',
2127                                         qr!if \$cc \$ccflags try\.c -o try >/dev/null 2>&1; then!)) {
2128         # Analogous to the more general fix of dfe9444ca7881e71
2129         # Without this flags such as -m64 may not be passed to this compile,
2130         # which results in a byteorder of '1234' instead of '12345678', which
2131         # can then cause crashes.
2132
2133         if (extract_from_file('Configure', qr/xxx_prompt=y/)) {
2134             # 8e07c86ebc651fe9 or later
2135             # ("This is my patch  patch.1n  for perl5.001.")
2136             apply_patch(<<'EOPATCH');
2137 diff --git a/Configure b/Configure
2138 index 62249dd..c5c384e 100755
2139 --- a/Configure
2140 +++ b/Configure
2141 @@ -8247,7 +8247,7 @@ main()
2142  }
2143  EOCP
2144         xxx_prompt=y
2145 -       if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
2146 +       if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
2147                 dflt=`./try`
2148                 case "$dflt" in
2149                 [1-4][1-4][1-4][1-4]|12345678|87654321)
2150 EOPATCH
2151         } else {
2152             apply_patch(<<'EOPATCH');
2153 diff --git a/Configure b/Configure
2154 index 53649d5..f1cd64a 100755
2155 --- a/Configure
2156 +++ b/Configure
2157 @@ -6362,7 +6362,7 @@ main()
2158         printf("\n");
2159  }
2160  EOCP
2161 -       if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then
2162 +       if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 ; then
2163                 dflt=`./try`
2164                 case "$dflt" in
2165                 ????|????????) echo "(The test program ran ok.)";;
2166 EOPATCH
2167         }
2168     }
2169
2170     if ($major < 6 && !extract_from_file('Configure',
2171                                          qr!^\t-A\)$!)) {
2172         # This adds the -A option to Configure, which is incredibly useful
2173         # Effectively this is commits 02e93a22d20fc9a5, 5f83a3e9d818c3ad,
2174         # bde6b06b2c493fef, f7c3111703e46e0c and 2 lines of trailing whitespace
2175         # removed by 613d6c3e99b9decc, but applied at slightly different
2176         # locations to ensure a clean patch back to 5.000
2177         # Note, if considering patching to the intermediate revisions to fix
2178         # bugs in -A handling, f7c3111703e46e0c is from 2002, and hence
2179         # $major == 8
2180
2181         # To add to the fun, early patches add -K and -O options, and it's not
2182         # trivial to get patch to put the C<. ./posthint.sh> in the right place
2183         edit_file('Configure', sub {
2184                       my $code = shift;
2185                       $code =~ s/(optstr = ")([^"]+";\s*# getopt-style specification)/$1A:$2/
2186                           or die_255("Substitution failed");
2187                       $code =~ s!^(: who configured the system)!
2188 touch posthint.sh
2189 . ./posthint.sh
2190
2191 $1!ms
2192                           or die_255("Substitution failed");
2193                       return $code;
2194                   });
2195         apply_patch(<<'EOPATCH');
2196 diff --git a/Configure b/Configure
2197 index 4b55fa6..60c3c64 100755
2198 --- a/Configure
2199 +++ b/Configure
2200 @@ -1150,6 +1150,7 @@ set X `for arg in "$@"; do echo "X$arg"; done |
2201  eval "set $*"
2202  shift
2203  rm -f options.awk
2204 +rm -f posthint.sh
2205
2206  : set up default values
2207  fastread=''
2208 @@ -1172,6 +1173,56 @@ while test $# -gt 0; do
2209         case "$1" in
2210         -d) shift; fastread=yes;;
2211         -e) shift; alldone=cont;;
2212 +       -A)
2213 +           shift
2214 +           xxx=''
2215 +           yyy="$1"
2216 +           zzz=''
2217 +           uuu=undef
2218 +           case "$yyy" in
2219 +            *=*) zzz=`echo "$yyy"|sed 's!=.*!!'`
2220 +                 case "$zzz" in
2221 +                 *:*) zzz='' ;;
2222 +                 *)   xxx=append
2223 +                      zzz=" "`echo "$yyy"|sed 's!^[^=]*=!!'`
2224 +                      yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
2225 +                 esac
2226 +                 ;;
2227 +            esac
2228 +            case "$xxx" in
2229 +            '')  case "$yyy" in
2230 +                 *:*) xxx=`echo "$yyy"|sed 's!:.*!!'`
2231 +                      yyy=`echo "$yyy"|sed 's!^[^:]*:!!'`
2232 +                      zzz=`echo "$yyy"|sed 's!^[^=]*=!!'`
2233 +                      yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
2234 +                 *)   xxx=`echo "$yyy"|sed 's!:.*!!'`
2235 +                      yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` ;;
2236 +                 esac
2237 +                 ;;
2238 +            esac
2239 +           case "$xxx" in
2240 +           append)
2241 +               echo "$yyy=\"\${$yyy}$zzz\""    >> posthint.sh ;;
2242 +           clear)
2243 +               echo "$yyy=''"                  >> posthint.sh ;;
2244 +           define)
2245 +               case "$zzz" in
2246 +               '') zzz=define ;;
2247 +               esac
2248 +               echo "$yyy='$zzz'"              >> posthint.sh ;;
2249 +           eval)
2250 +               echo "eval \"$yyy=$zzz\""       >> posthint.sh ;;
2251 +           prepend)
2252 +               echo "$yyy=\"$zzz\${$yyy}\""    >> posthint.sh ;;
2253 +           undef)
2254 +               case "$zzz" in
2255 +               '') zzz="$uuu" ;;
2256 +               esac
2257 +               echo "$yyy=$zzz"                >> posthint.sh ;;
2258 +            *)  echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2 ;;
2259 +           esac
2260 +           shift
2261 +           ;;
2262         -f)
2263                 shift
2264                 cd ..
2265 EOPATCH
2266     }
2267
2268     if ($major < 8 && $^O eq 'aix') {
2269         edit_file('Configure', sub {
2270                       my $code = shift;
2271                       # Replicate commit a8c676c69574838b
2272                       # Whitespace allowed at the ends of /lib/syscalls.exp lines
2273                       # and half of commit c6912327ae30e6de
2274                       # AIX syscalls.exp scan: the syscall might be marked 32, 3264, or 64
2275                       $code =~ s{(\bsed\b.*\bsyscall)(?:\[0-9\]\*)?(\$.*/lib/syscalls\.exp)}
2276                                 {$1 . "[0-9]*[ \t]*" . $2}e;
2277                       return $code;
2278                   });
2279     }
2280
2281     if ($major < 8 && !extract_from_file('Configure',
2282                                          qr/^\t\tif test ! -t 0; then$/)) {
2283         # Before dfe9444ca7881e71, Configure would refuse to run if stdin was
2284         # not a tty. With that commit, the tty requirement was dropped for -de
2285         # and -dE
2286         # Commit aaeb8e512e8e9e14 dropped the tty requirement for -S
2287         # For those older versions, it's probably easiest if we simply remove
2288         # the sanity test.
2289         edit_file('Configure', sub {
2290                       my $code = shift;
2291                       $code =~ s/test ! -t 0/test Perl = rules/;
2292                       return $code;
2293                   });
2294     }
2295
2296     if ($major == 8 || $major == 9) {
2297         # Fix symbol detection to that of commit 373dfab3839ca168 if it's any
2298         # intermediate version 5129fff43c4fe08c or later, as the intermediate
2299         # versions don't work correctly on (at least) Sparc Linux.
2300         # 5129fff43c4fe08c adds the first mention of mistrustnm.
2301         # 373dfab3839ca168 removes the last mention of lc=""
2302         edit_file('Configure', sub {
2303                       my $code = shift;
2304                       return $code
2305                           if $code !~ /\btc="";/; # 373dfab3839ca168 or later
2306                       return $code
2307                           if $code !~ /\bmistrustnm\b/; # before 5129fff43c4fe08c
2308                       my $fixed = <<'EOC';
2309
2310 : is a C symbol defined?
2311 csym='tlook=$1;
2312 case "$3" in
2313 -v) tf=libc.tmp; tdc="";;
2314 -a) tf=libc.tmp; tdc="[]";;
2315 *) tlook="^$1\$"; tf=libc.list; tdc="()";;
2316 esac;
2317 tx=yes;
2318 case "$reuseval-$4" in
2319 true-) ;;
2320 true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;;
2321 esac;
2322 case "$tx" in
2323 yes)
2324         tval=false;
2325         if $test "$runnm" = true; then
2326                 if $contains $tlook $tf >/dev/null 2>&1; then
2327                         tval=true;
2328                 elif $test "$mistrustnm" = compile -o "$mistrustnm" = run; then
2329                         echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
2330                         $cc -o try $optimize $ccflags $ldflags try.c >/dev/null 2>&1 $libs && tval=true;
2331                         $test "$mistrustnm" = run -a -x try && { $run ./try$_exe >/dev/null 2>&1 || tval=false; };
2332                         $rm -f try$_exe try.c core core.* try.core;
2333                 fi;
2334         else
2335                 echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
2336                 $cc -o try $optimize $ccflags $ldflags try.c $libs >/dev/null 2>&1 && tval=true;
2337                 $rm -f try$_exe try.c;
2338         fi;
2339         ;;
2340 *)
2341         case "$tval" in
2342         $define) tval=true;;
2343         *) tval=false;;
2344         esac;
2345         ;;
2346 esac;
2347 eval "$2=$tval"'
2348
2349 EOC
2350                       $code =~ s/\n: is a C symbol defined\?\n.*?\neval "\$2=\$tval"'\n\n/$fixed/sm
2351                           or die_255("substitution failed");
2352                       return $code;
2353                   });
2354     }
2355
2356     if ($major < 10
2357         && extract_from_file('Configure', qr/^set malloc\.h i_malloc$/)) {
2358         # This is commit 01d07975f7ef0e7d, trimmed, with $compile inlined as
2359         # prior to bd9b35c97ad661cc Configure had the malloc.h test before the
2360         # definition of $compile.
2361         apply_patch(<<'EOPATCH');
2362 diff --git a/Configure b/Configure
2363 index 3d2e8b9..6ce7766 100755
2364 --- a/Configure
2365 +++ b/Configure
2366 @@ -6743,5 +6743,22 @@ set d_dosuid
2367
2368  : see if this is a malloc.h system
2369 -set malloc.h i_malloc
2370 -eval $inhdr
2371 +: we want a real compile instead of Inhdr because some systems have a
2372 +: malloc.h that just gives a compile error saying to use stdlib.h instead
2373 +echo " "
2374 +$cat >try.c <<EOCP
2375 +#include <stdlib.h>
2376 +#include <malloc.h>
2377 +int main () { return 0; }
2378 +EOCP
2379 +set try
2380 +if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then
2381 +    echo "<malloc.h> found." >&4
2382 +    val="$define"
2383 +else
2384 +    echo "<malloc.h> NOT found." >&4
2385 +    val="$undef"
2386 +fi
2387 +$rm -f try.c try
2388 +set i_malloc
2389 +eval $setvar
2390
2391 EOPATCH
2392     }
2393 }
2394
2395 sub patch_hints {
2396     if ($^O eq 'freebsd') {
2397         # There are rather too many version-specific FreeBSD hints fixes to
2398         # patch individually. Also, more than once the FreeBSD hints file has
2399         # been written in what turned out to be a rather non-future-proof style,
2400         # with case statements treating the most recent version as the
2401         # exception, instead of treating previous versions' behaviour explicitly
2402         # and changing the default to cater for the current behaviour. (As
2403         # strangely, future versions inherit the current behaviour.)
2404         checkout_file('hints/freebsd.sh');
2405     } elsif ($^O eq 'darwin') {
2406         if ($major < 8) {
2407             # We can't build on darwin without some of the data in the hints
2408             # file. Probably less surprising to use the earliest version of
2409             # hints/darwin.sh and then edit in place just below, than use
2410             # blead's version, as that would create a discontinuity at
2411             # f556e5b971932902 - before it, hints bugs would be "fixed", after
2412             # it they'd resurface. This way, we should give the illusion of
2413             # monotonic bug fixing.
2414             my $faking_it;
2415             if (!-f 'hints/darwin.sh') {
2416                 checkout_file('hints/darwin.sh', 'f556e5b971932902');
2417                 ++$faking_it;
2418             }
2419
2420             edit_file('hints/darwin.sh', sub {
2421                       my $code = shift;
2422                       # Part of commit 8f4f83badb7d1ba9, which mostly undoes
2423                       # commit 0511a818910f476c.
2424                       $code =~ s/^cppflags='-traditional-cpp';$/cppflags="\${cppflags} -no-cpp-precomp"/m;
2425                       # commit 14c11978e9b52e08/803bb6cc74d36a3f
2426                       # Without this, code in libperl.bundle links against op.o
2427                       # in preference to opmini.o on the linker command line,
2428                       # and hence miniperl tries to use File::Glob instead of
2429                       # csh
2430                       $code =~ s/^(lddlflags=)/ldflags="\${ldflags} -flat_namespace"\n$1/m;
2431                       # f556e5b971932902 also patches Makefile.SH with some
2432                       # special case code to deal with useshrplib for darwin.
2433                       # Given that post 5.8.0 the darwin hints default was
2434                       # changed to false, and it would be very complex to splice
2435                       # in that code in various versions of Makefile.SH back
2436                       # to 5.002, lets just turn it off.
2437                       $code =~ s/^useshrplib='true'/useshrplib='false'/m
2438                           if $faking_it;
2439
2440                       # Part of commit d235852b65d51c44
2441                       # Don't do this on a case sensitive HFS+ partition, as it
2442                       # breaks the build for 5.003 and earlier.
2443                       if ($case_insensitive
2444                           && $code !~ /^firstmakefile=GNUmakefile/) {
2445                           $code .= "\nfirstmakefile=GNUmakefile;\n";
2446                       }
2447
2448                       return $code;
2449                   });
2450         }
2451     } elsif ($^O eq 'netbsd') {
2452         if ($major < 6) {
2453             # These are part of commit 099685bc64c7dbce
2454             edit_file('hints/netbsd.sh', sub {
2455                           my $code = shift;
2456                           my $fixed = <<'EOC';
2457 case "$osvers" in
2458 0.9|0.8*)
2459         usedl="$undef"
2460         ;;
2461 *)
2462         if [ -f /usr/libexec/ld.elf_so ]; then
2463                 d_dlopen=$define
2464                 d_dlerror=$define
2465                 ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags"
2466                 cccdlflags="-DPIC -fPIC $cccdlflags"
2467                 lddlflags="--whole-archive -shared $lddlflags"
2468         elif [ "`uname -m`" = "pmax" ]; then
2469 # NetBSD 1.3 and 1.3.1 on pmax shipped an 'old' ld.so, which will not work.
2470                 d_dlopen=$undef
2471         elif [ -f /usr/libexec/ld.so ]; then
2472                 d_dlopen=$define
2473                 d_dlerror=$define
2474                 ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags"
2475 # we use -fPIC here because -fpic is *NOT* enough for some of the
2476 # extensions like Tk on some netbsd platforms (the sparc is one)
2477                 cccdlflags="-DPIC -fPIC $cccdlflags"
2478                 lddlflags="-Bforcearchive -Bshareable $lddlflags"
2479         else
2480                 d_dlopen=$undef
2481         fi
2482         ;;
2483 esac
2484 EOC
2485                           $code =~ s/^case "\$osvers" in\n0\.9\|0\.8.*?^esac\n/$fixed/ms;
2486                           return $code;
2487                       });
2488         }
2489     } elsif ($^O eq 'openbsd') {
2490         if ($major < 8) {
2491             checkout_file('hints/openbsd.sh', '43051805d53a3e4c')
2492                 unless -f 'hints/openbsd.sh';
2493             my $which = extract_from_file('hints/openbsd.sh',
2494                                           qr/# from (2\.8|3\.1) onwards/,
2495                                           '');
2496             if ($which eq '') {
2497                 my $was = extract_from_file('hints/openbsd.sh',
2498                                             qr/(lddlflags="(?:-Bforcearchive )?-Bshareable)/);
2499                 # This is commit 154d43cbcf57271c and parts of 5c75dbfa77b0949c
2500                 # and 29b5585702e5e025
2501                 apply_patch(sprintf <<'EOPATCH', $was);
2502 diff --git a/hints/openbsd.sh b/hints/openbsd.sh
2503 index a7d8bf2..5b79709 100644
2504 --- a/hints/openbsd.sh
2505 +++ b/hints/openbsd.sh
2506 @@ -37,7 +37,25 @@ OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax)
2507         # we use -fPIC here because -fpic is *NOT* enough for some of the
2508         # extensions like Tk on some OpenBSD platforms (ie: sparc)
2509         cccdlflags="-DPIC -fPIC $cccdlflags"
2510 -       %s $lddlflags"
2511 +       case "$osvers" in
2512 +       [01].*|2.[0-7]|2.[0-7].*)
2513 +               lddlflags="-Bshareable $lddlflags"
2514 +               ;;
2515 +       2.[8-9]|3.0)
2516 +               ld=${cc:-cc}
2517 +               lddlflags="-shared -fPIC $lddlflags"
2518 +               ;;
2519 +       *) # from 3.1 onwards
2520 +               ld=${cc:-cc}
2521 +               lddlflags="-shared -fPIC $lddlflags"
2522 +               libswanted=`echo $libswanted | sed 's/ dl / /'`
2523 +               ;;
2524 +       esac
2525 +
2526 +       # We need to force ld to export symbols on ELF platforms.
2527 +       # Without this, dlopen() is crippled.
2528 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
2529 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
2530         ;;
2531  esac
2532
2533 EOPATCH
2534             } elsif ($which eq '2.8') {
2535                 # This is parts of 5c75dbfa77b0949c and 29b5585702e5e025, and
2536                 # possibly eb9cd59d45ad2908
2537                 my $was = extract_from_file('hints/openbsd.sh',
2538                                             qr/lddlflags="(-shared(?: -fPIC)?) \$lddlflags"/);
2539
2540                 apply_patch(sprintf <<'EOPATCH', $was);
2541 --- a/hints/openbsd.sh  2011-10-21 17:25:20.000000000 +0200
2542 +++ b/hints/openbsd.sh  2011-10-21 16:58:43.000000000 +0200
2543 @@ -44,11 +44,21 @@
2544         [01].*|2.[0-7]|2.[0-7].*)
2545                 lddlflags="-Bshareable $lddlflags"
2546                 ;;
2547 -       *) # from 2.8 onwards
2548 +       2.[8-9]|3.0)
2549                 ld=${cc:-cc}
2550 -               lddlflags="%s $lddlflags"
2551 +               lddlflags="-shared -fPIC $lddlflags"
2552 +               ;;
2553 +       *) # from 3.1 onwards
2554 +               ld=${cc:-cc}
2555 +               lddlflags="-shared -fPIC $lddlflags"
2556 +               libswanted=`echo $libswanted | sed 's/ dl / /'`
2557                 ;;
2558         esac
2559 +
2560 +       # We need to force ld to export symbols on ELF platforms.
2561 +       # Without this, dlopen() is crippled.
2562 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
2563 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
2564         ;;
2565  esac
2566
2567 EOPATCH
2568             } elsif ($which eq '3.1'
2569                      && !extract_from_file('hints/openbsd.sh',
2570                                            qr/We need to force ld to export symbols on ELF platforms/)) {
2571                 # This is part of 29b5585702e5e025
2572                 apply_patch(<<'EOPATCH');
2573 diff --git a/hints/openbsd.sh b/hints/openbsd.sh
2574 index c6b6bc9..4839d04 100644
2575 --- a/hints/openbsd.sh
2576 +++ b/hints/openbsd.sh
2577 @@ -54,6 +54,11 @@ alpha-2.[0-8]|mips-*|vax-*|powerpc-2.[0-7]|m88k-*)
2578                 libswanted=`echo $libswanted | sed 's/ dl / /'`
2579                 ;;
2580         esac
2581 +
2582 +       # We need to force ld to export symbols on ELF platforms.
2583 +       # Without this, dlopen() is crippled.
2584 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
2585 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
2586         ;;
2587  esac
2588
2589 EOPATCH
2590             }
2591         }
2592     } elsif ($^O eq 'linux') {
2593         if ($major < 1) {
2594             # sparc linux seems to need the -Dbool=char -DHAS_BOOL part of
2595             # perl5.000 patch.0n: [address Configure and build issues]
2596             edit_file('hints/linux.sh', sub {
2597                           my $code = shift;
2598                           $code =~ s!-I/usr/include/bsd!-Dbool=char -DHAS_BOOL!g;
2599                           return $code;
2600                       });
2601         }
2602
2603         if ($major <= 9) {
2604             if (`uname -sm` =~ qr/^Linux sparc/) {
2605                 if (extract_from_file('hints/linux.sh', qr/sparc-linux/)) {
2606                     # Be sure to use -fPIC not -fpic on Linux/SPARC
2607                     apply_commit('f6527d0ef0c13ad4');
2608                 } elsif(!extract_from_file('hints/linux.sh',
2609                                            qr/^sparc-linux\)$/)) {
2610                     my $fh = open_or_die('hints/linux.sh', '>>');
2611                     print $fh <<'EOT' or die_255($!);
2612
2613 case "`uname -m`" in
2614 sparc*)
2615         case "$cccdlflags" in
2616         *-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;;
2617         *)       cccdlflags="$cccdlflags -fPIC" ;;
2618         esac
2619         ;;
2620 esac
2621 EOT
2622                     close_or_die($fh);
2623                 }
2624             }
2625         }
2626     } elsif ($^O eq 'solaris') {
2627         if (($major == 13 || $major == 14)
2628             && extract_from_file('hints/solaris_2.sh', qr/getconfldllflags/)) {
2629             apply_commit('c80bde4388070c45');
2630         }
2631     }
2632 }
2633
2634 sub patch_SH {
2635     # Cwd.xs added in commit 0d2079faa739aaa9. Cwd.pm moved to ext/ 8 years
2636     # later in commit 403f501d5b37ebf0
2637     if ($major > 0 && <*/Cwd/Cwd.xs>) {
2638         if ($major < 10
2639             && !extract_from_file('Makefile.SH', qr/^extra_dep=''$/)) {
2640             # The Makefile.PL for Unicode::Normalize needs
2641             # lib/unicore/CombiningClass.pl. Even without a parallel build, we
2642             # need a dependency to ensure that it builds. This is a variant of
2643             # commit 9f3ef600c170f61e. Putting this for earlier versions gives
2644             # us a spot on which to hang the edits below
2645             apply_patch(<<'EOPATCH');
2646 diff --git a/Makefile.SH b/Makefile.SH
2647 index f61d0db..6097954 100644
2648 --- a/Makefile.SH
2649 +++ b/Makefile.SH
2650 @@ -155,10 +155,20 @@ esac
2651
2652  : Prepare dependency lists for Makefile.
2653  dynamic_list=' '
2654 +extra_dep=''
2655  for f in $dynamic_ext; do
2656      : the dependency named here will never exist
2657        base=`echo "$f" | sed 's/.*\///'`
2658 -    dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext"
2659 +    this_target="lib/auto/$f/$base.$dlext"
2660 +    dynamic_list="$dynamic_list $this_target"
2661 +
2662 +    : Parallel makes reveal that we have some interdependencies
2663 +    case $f in
2664 +       Math/BigInt/FastCalc) extra_dep="$extra_dep
2665 +$this_target: lib/auto/List/Util/Util.$dlext" ;;
2666 +       Unicode/Normalize) extra_dep="$extra_dep
2667 +$this_target: lib/unicore/CombiningClass.pl" ;;
2668 +    esac
2669  done
2670
2671  static_list=' '
2672 @@ -987,2 +997,9 @@ n_dummy $(nonxs_ext):       miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE
2673         @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
2674 +!NO!SUBS!
2675 +
2676 +$spitshell >>Makefile <<EOF
2677 +$extra_dep
2678 +EOF
2679 +
2680 +$spitshell >>Makefile <<'!NO!SUBS!'
2681
2682 EOPATCH
2683         }
2684
2685         if ($major == 15 && $^O !~ /^(linux|darwin|.*bsd)$/
2686             && extract_from_file('Makefile.SH', qr/^V.* \?= /)) {
2687             # Remove the GNU-make-ism (which the BSD makes also support, but
2688             # most other makes choke on)
2689             apply_patch(<<'EOPATCH');
2690 diff --git a/Makefile.SH b/Makefile.SH
2691 index 94952bd..13e9001 100755
2692 --- a/Makefile.SH
2693 +++ b/Makefile.SH
2694 @@ -338,8 +338,8 @@ linux*|darwin)
2695  $spitshell >>$Makefile <<!GROK!THIS!
2696  # If you're going to use valgrind and it can't be invoked as plain valgrind
2697  # then you'll need to change this, or override it on the make command line.
2698 -VALGRIND ?= valgrind
2699 -VG_TEST  ?= ./perl -e 1 2>/dev/null
2700 +VALGRIND = valgrind
2701 +VG_TEST  = ./perl -e 1 2>/dev/null
2702
2703  !GROK!THIS!
2704         ;;
2705 EOPATCH
2706         }
2707
2708         if ($major == 11) {
2709             if (extract_from_file('patchlevel.h',
2710                                   qr/^#include "unpushed\.h"/)) {
2711                 # I had thought it easier to detect when building one of the 52
2712                 # commits with the original method of incorporating the git
2713                 # revision and drop parallel make flags. Commits shown by
2714                 # git log 46807d8e809cc127^..dcff826f70bf3f64^ ^d4fb0a1f15d1a1c4
2715                 # However, it's not actually possible to make miniperl for that
2716                 # configuration as-is, because the file .patchnum is only made
2717                 # as a side effect of target 'all'
2718                 # I also don't think that it's "safe" to simply run
2719                 # make_patchnum.sh before the build. We need the proper
2720                 # dependency rules in the Makefile to *stop* it being run again
2721                 # at the wrong time.
2722                 # This range is important because contains the commit that
2723                 # merges Schwern's y2038 work.
2724                 apply_patch(<<'EOPATCH');
2725 diff --git a/Makefile.SH b/Makefile.SH
2726 index 9ad8b6f..106e721 100644
2727 --- a/Makefile.SH
2728 +++ b/Makefile.SH
2729 @@ -540,9 +544,14 @@ sperl.i: perl.c $(h)
2730
2731  .PHONY: all translators utilities make_patchnum
2732
2733 -make_patchnum:
2734 +make_patchnum: lib/Config_git.pl
2735 +
2736 +lib/Config_git.pl: make_patchnum.sh
2737         sh $(shellflags) make_patchnum.sh
2738
2739 +# .patchnum, unpushed.h and lib/Config_git.pl are built by make_patchnum.sh
2740 +unpushed.h .patchnum: lib/Config_git.pl
2741 +
2742  # make sure that we recompile perl.c if .patchnum changes
2743  perl$(OBJ_EXT): .patchnum unpushed.h
2744
2745 EOPATCH
2746             } elsif (-f '.gitignore'
2747                      && extract_from_file('.gitignore', qr/^\.patchnum$/)) {
2748                 # 8565263ab8a47cda to 46807d8e809cc127^ inclusive.
2749                 edit_file('Makefile.SH', sub {
2750                               my $code = shift;
2751                               $code =~ s/^make_patchnum:\n/make_patchnum: .patchnum
2752
2753 .sha1: .patchnum
2754
2755 .patchnum: make_patchnum.sh
2756 /m;
2757                               return $code;
2758                           });
2759             } elsif (-f 'lib/.gitignore'
2760                      && extract_from_file('lib/.gitignore',
2761                                           qr!^/Config_git.pl!)
2762                      && !extract_from_file('Makefile.SH',
2763                                         qr/^uudmap\.h.*:bitcount.h$/)) {
2764                 # Between commits and dcff826f70bf3f64 and 0f13ebd5d71f8177^
2765                 edit_file('Makefile.SH', sub {
2766                               my $code = shift;
2767                               # Bug introduced by 344af494c35a9f0f
2768                               # fixed in 0f13ebd5d71f8177
2769                               $code =~ s{^(pod/perlapi\.pod) (pod/perlintern\.pod): }
2770                                         {$1: $2\n\n$2: }m;
2771                               # Bug introduced by efa50c51e3301a2c
2772                               # fixed in 0f13ebd5d71f8177
2773                               $code =~ s{^(uudmap\.h) (bitcount\.h): }
2774                                         {$1: $2\n\n$2: }m;
2775
2776                               # The rats nest of getting git_version.h correct
2777
2778                               if ($code =~ s{git_version\.h: stock_git_version\.h
2779 \tcp stock_git_version\.h git_version\.h}
2780                                             {}m) {
2781                                   # before 486cd780047ff224
2782
2783                                   # We probably can't build between
2784                                   # 953f6acfa20ec275^ and 8565263ab8a47cda
2785                                   # inclusive, but all commits in that range
2786                                   # relate to getting make_patchnum.sh working,
2787                                   # so it is extremely unlikely to be an
2788                                   # interesting bisect target. They will skip.
2789
2790                                   # No, don't spawn a submake if
2791                                   # make_patchnum.sh or make_patchnum.pl fails
2792                                   $code =~ s{\|\| \$\(MAKE\) miniperl.*}
2793                                             {}m;
2794                                   $code =~ s{^\t(sh.*make_patchnum\.sh.*)}
2795                                             {\t-$1}m;
2796
2797                                   # Use an external perl to run make_patchnum.pl
2798                                   # because miniperl still depends on
2799                                   # git_version.h
2800                                   $code =~ s{^\t.*make_patchnum\.pl}
2801                                             {\t-$^X make_patchnum.pl}m;
2802
2803
2804                                   # "Truth in advertising" - running
2805                                   # make_patchnum generates 2 files.
2806                                   $code =~ s{^make_patchnum:.*}{
2807 make_patchnum: lib/Config_git.pl
2808
2809 git_version.h: lib/Config_git.pl
2810
2811 perlmini\$(OBJ_EXT): git_version.h
2812
2813 lib/Config_git.pl:}m;
2814                               }
2815                               # Right, now we've corrected Makefile.SH to
2816                               # correctly describe how lib/Config_git.pl and
2817                               # git_version.h are made, we need to fix the rest
2818
2819                               # This emulates commit 2b63e250843b907e
2820                               # This might duplicate the rule stating that
2821                               # git_version.h depends on lib/Config_git.pl
2822                               # This is harmless.
2823                               $code =~ s{^(?:lib/Config_git\.pl )?git_version\.h: (.* make_patchnum\.pl.*)}
2824                                         {git_version.h: lib/Config_git.pl
2825
2826 lib/Config_git.pl: $1}m;
2827
2828                               # This emulates commits 0f13ebd5d71f8177
2829                               # and a04d4598adc57886. It ensures that
2830                               # lib/Config_git.pl is built before configpm,
2831                               # and that configpm is run exactly once.
2832                               $code =~ s{^(\$\(.*?\) )?(\$\(CONFIGPOD\))(: .*? configpm Porting/Glossary)( lib/Config_git\.pl)?}{
2833                                   # If present, other files depend on $(CONFIGPOD)
2834                                   ($1 ? "$1: $2\n\n" : '')
2835                                       # Then the rule we found
2836                                       . $2 . $3
2837                                           # Add dependency if not there
2838                                           . ($4 ? $4 : ' lib/Config_git.pl')
2839                               }me;
2840
2841                               return $code;
2842                           });
2843             }
2844         }
2845
2846         if ($major < 14) {
2847             # Commits dc0655f797469c47 and d11a62fe01f2ecb2
2848             edit_file('Makefile.SH', sub {
2849                           my $code = shift;
2850                           foreach my $ext (qw(Encode SDBM_File)) {
2851                               next if $code =~ /\b$ext\) extra_dep=/s;
2852                               $code =~ s!(\) extra_dep="\$extra_dep
2853 \$this_target: .*?" ;;)
2854 (    esac
2855 )!$1
2856         $ext) extra_dep="\$extra_dep
2857 \$this_target: lib/auto/Cwd/Cwd.\$dlext" ;;
2858 $2!;
2859                           }
2860                           return $code;
2861                       });
2862         }
2863     }
2864
2865     if ($major == 7) {
2866         # Remove commits 9fec149bb652b6e9 and 5bab1179608f81d8, which add/amend
2867         # rules to automatically run regen scripts that rebuild C headers. These
2868         # cause problems because a git checkout doesn't preserve relative file
2869         # modification times, hence the regen scripts may fire. This will
2870         # obscure whether the repository had the correct generated headers
2871         # checked in.
2872         # Also, the dependency rules for running the scripts were not correct,
2873         # which could cause spurious re-builds on re-running make, and can cause
2874         # complete build failures for a parallel make.
2875         if (extract_from_file('Makefile.SH',
2876                               qr/Writing it this way gives make a big hint to always run opcode\.pl before/)) {
2877             apply_commit('70c6e6715e8fec53');
2878         } elsif (extract_from_file('Makefile.SH',
2879                                    qr/^opcode\.h opnames\.h pp_proto\.h pp\.sym: opcode\.pl$/)) {
2880             revert_commit('9fec149bb652b6e9');
2881         }
2882     }
2883
2884     if ($^O eq 'aix' && $major >= 11 && $major <= 15
2885         && extract_from_file('makedef.pl', qr/^use Config/)) {
2886         edit_file('Makefile.SH', sub {
2887                       # The AIX part of commit e6807d8ab22b761c
2888                       # It's safe to substitute lib/Config.pm for config.sh
2889                       # as lib/Config.pm depends on config.sh
2890                       # If the tree is post e6807d8ab22b761c, the substitution
2891                       # won't match, which is harmless.
2892                       my $code = shift;
2893                       $code =~ s{^(perl\.exp:.* )config\.sh(\b.*)}
2894                                 {$1 . '$(CONFIGPM)' . $2}me;
2895                       return $code;
2896                   });
2897     }
2898
2899     # There was a bug in makedepend.SH which was fixed in version 96a8704c.
2900     # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
2901     # Remove this if you're actually bisecting a problem related to
2902     # makedepend.SH
2903     # If you do this, you may need to add in code to correct the output of older
2904     # makedepends, which don't correctly filter newer gcc output such as
2905     # <built-in>
2906     checkout_file('makedepend.SH');
2907
2908     if ($major < 4 && -f 'config.sh'
2909         && !extract_from_file('config.sh', qr/^trnl=/)) {
2910         # This seems to be necessary to avoid makedepend becoming confused,
2911         # and hanging on stdin. Seems that the code after
2912         # make shlist || ...here... is never run.
2913         edit_file('makedepend.SH', sub {
2914                       my $code = shift;
2915                       $code =~ s/^trnl='\$trnl'$/trnl='\\n'/m;
2916                       return $code;
2917                   });
2918     }
2919 }
2920
2921 sub patch_C {
2922     # This is ordered by $major, as it's likely that different platforms may
2923     # well want to share code.
2924
2925     if ($major == 2 && extract_from_file('perl.c', qr/^\tfclose\(e_fp\);$/)) {
2926         # need to patch perl.c to avoid calling fclose() twice on e_fp when
2927         # using -e
2928         # This diff is part of commit ab821d7fdc14a438. The second close was
2929         # introduced with perl-5.002, commit a5f75d667838e8e7
2930         # Might want a6c477ed8d4864e6 too, for the corresponding change to
2931         # pp_ctl.c (likely without this, eval will have "fun")
2932         apply_patch(<<'EOPATCH');
2933 diff --git a/perl.c b/perl.c
2934 index 03c4d48..3c814a2 100644
2935 --- a/perl.c
2936 +++ b/perl.c
2937 @@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
2938  #ifndef VMS  /* VMS doesn't have environ array */
2939      origenviron = environ;
2940  #endif
2941 +    e_tmpname = Nullch;
2942
2943      if (do_undump) {
2944
2945 @@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
2946      if (e_fp) {
2947         if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
2948             croak("Can't write to temp file for -e: %s", Strerror(errno));
2949 +       e_fp = Nullfp;
2950         argc++,argv--;
2951         scriptname = e_tmpname;
2952      }
2953 @@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
2954      curcop->cop_line = 0;
2955      curstash = defstash;
2956      preprocess = FALSE;
2957 -    if (e_fp) {
2958 -       fclose(e_fp);
2959 -       e_fp = Nullfp;
2960 +    if (e_tmpname) {
2961         (void)UNLINK(e_tmpname);
2962 +       Safefree(e_tmpname);
2963 +       e_tmpname = Nullch;
2964      }
2965
2966      /* now that script is parsed, we can modify record separator */
2967 @@ -1369,7 +1371,7 @@ SV *sv;
2968         scriptname = xfound;
2969      }
2970
2971 -    origfilename = savepv(e_fp ? "-e" : scriptname);
2972 +    origfilename = savepv(e_tmpname ? "-e" : scriptname);
2973      curcop->cop_filegv = gv_fetchfile(origfilename);
2974      if (strEQ(origfilename,"-"))
2975         scriptname = "";
2976
2977 EOPATCH
2978     }
2979
2980     if ($major < 3 && $^O eq 'openbsd'
2981         && !extract_from_file('pp_sys.c', qr/BSD_GETPGRP/)) {
2982         # Part of commit c3293030fd1b7489
2983         apply_patch(<<'EOPATCH');
2984 diff --git a/pp_sys.c b/pp_sys.c
2985 index 4608a2a..f0c9d1d 100644
2986 --- a/pp_sys.c
2987 +++ b/pp_sys.c
2988 @@ -2903,8 +2903,8 @@ PP(pp_getpgrp)
2989         pid = 0;
2990      else
2991         pid = SvIVx(POPs);
2992 -#ifdef USE_BSDPGRP
2993 -    value = (I32)getpgrp(pid);
2994 +#ifdef BSD_GETPGRP
2995 +    value = (I32)BSD_GETPGRP(pid);
2996  #else
2997      if (pid != 0)
2998         DIE("POSIX getpgrp can't take an argument");
2999 @@ -2933,8 +2933,8 @@ PP(pp_setpgrp)
3000      }
3001
3002      TAINT_PROPER("setpgrp");
3003 -#ifdef USE_BSDPGRP
3004 -    SETi( setpgrp(pid, pgrp) >= 0 );
3005 +#ifdef BSD_SETPGRP
3006 +    SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
3007  #else
3008      if ((pgrp != 0) || (pid != 0)) {
3009         DIE("POSIX setpgrp can't take an argument");
3010 EOPATCH
3011     }
3012
3013     if ($major < 4 && $^O eq 'openbsd') {
3014         my $bad;
3015         # Need changes from commit a6e633defa583ad5.
3016         # Commits c07a80fdfe3926b5 and f82b3d4130164d5f changed the same part
3017         # of perl.h
3018
3019         if (extract_from_file('perl.h',
3020                               qr/^#ifdef HAS_GETPGRP2$/)) {
3021             $bad = <<'EOBAD';
3022 ***************
3023 *** 57,71 ****
3024   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
3025   #define TAINT_ENV()   if (tainting) taint_env()
3026
3027 ! #ifdef HAS_GETPGRP2
3028 ! #   ifndef HAS_GETPGRP
3029 ! #     define HAS_GETPGRP
3030 ! #   endif
3031 ! #endif
3032 !
3033 ! #ifdef HAS_SETPGRP2
3034 ! #   ifndef HAS_SETPGRP
3035 ! #     define HAS_SETPGRP
3036 ! #   endif
3037   #endif
3038
3039 EOBAD
3040         } elsif (extract_from_file('perl.h',
3041                                    qr/Gack, you have one but not both of getpgrp2/)) {
3042             $bad = <<'EOBAD';
3043 ***************
3044 *** 56,76 ****
3045   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
3046   #define TAINT_ENV()   if (tainting) taint_env()
3047
3048 ! #if defined(HAS_GETPGRP2) && defined(HAS_SETPGRP2)
3049 ! #   define getpgrp getpgrp2
3050 ! #   define setpgrp setpgrp2
3051 ! #   ifndef HAS_GETPGRP
3052 ! #     define HAS_GETPGRP
3053 ! #   endif
3054 ! #   ifndef HAS_SETPGRP
3055 ! #     define HAS_SETPGRP
3056 ! #   endif
3057 ! #   ifndef USE_BSDPGRP
3058 ! #     define USE_BSDPGRP
3059 ! #   endif
3060 ! #else
3061 ! #   if defined(HAS_GETPGRP2) || defined(HAS_SETPGRP2)
3062 !       #include "Gack, you have one but not both of getpgrp2() and setpgrp2()."
3063 ! #   endif
3064   #endif
3065
3066 EOBAD
3067         } elsif (extract_from_file('perl.h',
3068                                    qr/^#ifdef USE_BSDPGRP$/)) {
3069             $bad = <<'EOBAD'
3070 ***************
3071 *** 91,116 ****
3072   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
3073   #define TAINT_ENV()   if (tainting) taint_env()
3074
3075 ! #ifdef USE_BSDPGRP
3076 ! #   ifdef HAS_GETPGRP
3077 ! #       define BSD_GETPGRP(pid) getpgrp((pid))
3078 ! #   endif
3079 ! #   ifdef HAS_SETPGRP
3080 ! #       define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
3081 ! #   endif
3082 ! #else
3083 ! #   ifdef HAS_GETPGRP2
3084 ! #       define BSD_GETPGRP(pid) getpgrp2((pid))
3085 ! #       ifndef HAS_GETPGRP
3086 ! #         define HAS_GETPGRP
3087 ! #     endif
3088 ! #   endif
3089 ! #   ifdef HAS_SETPGRP2
3090 ! #       define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
3091 ! #       ifndef HAS_SETPGRP
3092 ! #         define HAS_SETPGRP
3093 ! #     endif
3094 ! #   endif
3095   #endif
3096
3097   #ifndef _TYPES_               /* If types.h defines this it's easy. */
3098 EOBAD
3099         }
3100         if ($bad) {
3101             apply_patch(<<"EOPATCH");
3102 *** a/perl.h    2011-10-21 09:46:12.000000000 +0200
3103 --- b/perl.h    2011-10-21 09:46:12.000000000 +0200
3104 $bad--- 91,144 ----
3105   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
3106   #define TAINT_ENV()   if (tainting) taint_env()
3107
3108 ! /* XXX All process group stuff is handled in pp_sys.c.  Should these
3109 !    defines move there?  If so, I could simplify this a lot. --AD  9/96.
3110 ! */
3111 ! /* Process group stuff changed from traditional BSD to POSIX.
3112 !    perlfunc.pod documents the traditional BSD-style syntax, so we'll
3113 !    try to preserve that, if possible.
3114 ! */
3115 ! #ifdef HAS_SETPGID
3116 ! #  define BSD_SETPGRP(pid, pgrp)      setpgid((pid), (pgrp))
3117 ! #else
3118 ! #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
3119 ! #    define BSD_SETPGRP(pid, pgrp)    setpgrp((pid), (pgrp))
3120 ! #  else
3121 ! #    ifdef HAS_SETPGRP2  /* DG/UX */
3122 ! #      define BSD_SETPGRP(pid, pgrp)  setpgrp2((pid), (pgrp))
3123 ! #    endif
3124 ! #  endif
3125 ! #endif
3126 ! #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
3127 ! #  define HAS_SETPGRP  /* Well, effectively it does . . . */
3128 ! #endif
3129 !
3130 ! /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
3131 !     our life easier :-) so we'll try it.
3132 ! */
3133 ! #ifdef HAS_GETPGID
3134 ! #  define BSD_GETPGRP(pid)            getpgid((pid))
3135 ! #else
3136 ! #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
3137 ! #    define BSD_GETPGRP(pid)          getpgrp((pid))
3138 ! #  else
3139 ! #    ifdef HAS_GETPGRP2  /* DG/UX */
3140 ! #      define BSD_GETPGRP(pid)                getpgrp2((pid))
3141 ! #    endif
3142 ! #  endif
3143 ! #endif
3144 ! #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
3145 ! #  define HAS_GETPGRP  /* Well, effectively it does . . . */
3146 ! #endif
3147 !
3148 ! /* These are not exact synonyms, since setpgrp() and getpgrp() may
3149 !    have different behaviors, but perl.h used to define USE_BSDPGRP
3150 !    (prior to 5.003_05) so some extension might depend on it.
3151 ! */
3152 ! #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
3153 ! #  ifndef USE_BSDPGRP
3154 ! #    define USE_BSDPGRP
3155 ! #  endif
3156   #endif
3157
3158   #ifndef _TYPES_               /* If types.h defines this it's easy. */
3159 EOPATCH
3160         }
3161     }
3162
3163     if ($major < 4 && $^O eq 'hpux'
3164         && extract_from_file('sv.c', qr/i = _filbuf\(/)) {
3165             apply_patch(<<'EOPATCH');
3166 diff --git a/sv.c b/sv.c
3167 index a1f1d60..0a806f1 100644
3168 --- a/sv.c
3169 +++ b/sv.c
3170 @@ -2641,7 +2641,7 @@ I32 append;
3171
3172         FILE_cnt(fp) = cnt;             /* deregisterize cnt and ptr */
3173         FILE_ptr(fp) = ptr;
3174 -       i = _filbuf(fp);                /* get more characters */
3175 +       i = __filbuf(fp);               /* get more characters */
3176         cnt = FILE_cnt(fp);
3177         ptr = FILE_ptr(fp);             /* reregisterize cnt and ptr */
3178
3179
3180 EOPATCH
3181     }
3182
3183     if ($major == 4 && extract_from_file('scope.c', qr/\(SV\*\)SSPOPINT/)) {
3184         # [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void)
3185         # Fixes a bug introduced in 161b7d1635bc830b
3186         apply_commit('9002cb76ec83ef7f');
3187     }
3188
3189     if ($major == 4 && extract_from_file('av.c', qr/AvARRAY\(av\) = 0;/)) {
3190         # Fixes a bug introduced in 1393e20655efb4bc
3191         apply_commit('e1c148c28bf3335b', 'av.c');
3192     }
3193
3194     if ($major == 4) {
3195         my $rest = extract_from_file('perl.c', qr/delimcpy(.*)/);
3196         if (defined $rest and $rest !~ /,$/) {
3197             # delimcpy added in fc36a67e8855d031, perl.c refactored to use it.
3198             # bug introduced in 2a92aaa05aa1acbf, fixed in 8490252049bf42d3
3199             # code then moved to util.c in commit 491527d0220de34e
3200             apply_patch(<<'EOPATCH');
3201 diff --git a/perl.c b/perl.c
3202 index 4eb69e3..54bbb00 100644
3203 --- a/perl.c
3204 +++ b/perl.c
3205 @@ -1735,7 +1735,7 @@ SV *sv;
3206             if (len < sizeof tokenbuf)
3207                 tokenbuf[len] = '\0';
3208  #else  /* ! (atarist || DOSISH) */
3209 -           s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend
3210 +           s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
3211                          ':',
3212                          &len);
3213  #endif /* ! (atarist || DOSISH) */
3214 EOPATCH
3215         }
3216     }
3217
3218     if ($major == 4 && $^O eq 'linux') {
3219         # Whilst this is fixed properly in f0784f6a4c3e45e1 which provides the
3220         # Configure probe, it's easier to back out the problematic changes made
3221         # in these previous commits.
3222
3223         # In maint-5.004, the simplest addition is to "correct" the file to
3224         # use the same pre-processor macros as blead had used. Whilst commit
3225         # 9b599b2a63d2324d (reverted below) is described as
3226         # [win32] merge change#887 from maintbranch
3227         # it uses __sun__ and __svr4__ instead of the __sun and __SVR4 of the
3228         # maint branch commit 6cdf74fe31f049dc
3229
3230         edit_file('doio.c', sub {
3231                       my $code = shift;
3232                       $code =~ s{defined\(__sun\) && defined\(__SVR4\)}
3233                                 {defined(__sun__) && defined(__svr4__)}g;
3234                       return $code;
3235                   });
3236
3237         if (extract_from_file('doio.c',
3238                               qr!^/\* XXX REALLY need metaconfig test \*/$!)) {
3239             revert_commit('4682965a1447ea44', 'doio.c');
3240         }
3241         if (my $token = extract_from_file('doio.c',
3242                                           qr!^#if (defined\(__sun(?:__)?\)) && defined\(__svr4__\) /\* XXX Need metaconfig test \*/$!)) {
3243             my $patch = `git show -R 9b599b2a63d2324d doio.c`;
3244             $patch =~ s/defined\(__sun__\)/$token/g;
3245             apply_patch($patch);
3246         }
3247         if (extract_from_file('doio.c',
3248                               qr!^/\* linux \(and Solaris2\?\) uses :$!)) {
3249             revert_commit('8490252049bf42d3', 'doio.c');
3250         }
3251         if (extract_from_file('doio.c',
3252                               qr/^          unsemds.buf = &semds;$/)) {
3253             revert_commit('8e591e46b4c6543e');
3254         }
3255         if (extract_from_file('doio.c',
3256                               qr!^#ifdef __linux__      /\* XXX Need metaconfig test \*/$!)) {
3257             # Reverts part of commit 3e3baf6d63945cb6
3258             apply_patch(<<'EOPATCH');
3259 diff --git b/doio.c a/doio.c
3260 index 62b7de9..0d57425 100644
3261 --- b/doio.c
3262 +++ a/doio.c
3263 @@ -1333,9 +1331,6 @@ SV **sp;
3264      char *a;
3265      I32 id, n, cmd, infosize, getinfo;
3266      I32 ret = -1;
3267 -#ifdef __linux__       /* XXX Need metaconfig test */
3268 -    union semun unsemds;
3269 -#endif
3270
3271      id = SvIVx(*++mark);
3272      n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
3273 @@ -1364,29 +1359,11 @@ SV **sp;
3274             infosize = sizeof(struct semid_ds);
3275         else if (cmd == GETALL || cmd == SETALL)
3276         {
3277 -#ifdef __linux__       /* XXX Need metaconfig test */
3278 -/* linux uses :
3279 -   int semctl (int semid, int semnun, int cmd, union semun arg)
3280 -
3281 -       union semun {
3282 -            int val;
3283 -            struct semid_ds *buf;
3284 -            ushort *array;
3285 -       };
3286 -*/
3287 -            union semun semds;
3288 -           if (semctl(id, 0, IPC_STAT, semds) == -1)
3289 -#else
3290             struct semid_ds semds;
3291             if (semctl(id, 0, IPC_STAT, &semds) == -1)
3292 -#endif
3293                 return -1;
3294             getinfo = (cmd == GETALL);
3295 -#ifdef __linux__       /* XXX Need metaconfig test */
3296 -           infosize = semds.buf->sem_nsems * sizeof(short);
3297 -#else
3298             infosize = semds.sem_nsems * sizeof(short);
3299 -#endif
3300                 /* "short" is technically wrong but much more portable
3301                    than guessing about u_?short(_t)? */
3302         }
3303 @@ -1429,12 +1406,7 @@ SV **sp;
3304  #endif
3305  #ifdef HAS_SEM
3306      case OP_SEMCTL:
3307 -#ifdef __linux__       /* XXX Need metaconfig test */
3308 -        unsemds.buf = (struct semid_ds *)a;
3309 -       ret = semctl(id, n, cmd, unsemds);
3310 -#else
3311         ret = semctl(id, n, cmd, (struct semid_ds *)a);
3312 -#endif
3313         break;
3314  #endif
3315  #ifdef HAS_SHM
3316 EOPATCH
3317         }
3318         # Incorrect prototype added as part of 8ac853655d9b7447, fixed as part
3319         # of commit dc45a647708b6c54, with at least one intermediate
3320         # modification. Correct prototype for gethostbyaddr has socklen_t
3321         # second. Linux has uint32_t first for getnetbyaddr.
3322         # Easiest just to remove, instead of attempting more complex patching.
3323         # Something similar may be needed on other platforms.
3324         edit_file('pp_sys.c', sub {
3325                       my $code = shift;
3326                       $code =~ s/^    struct hostent \*(?:PerlSock_)?gethostbyaddr\([^)]+\);$//m;
3327                       $code =~ s/^    struct netent \*getnetbyaddr\([^)]+\);$//m;
3328                       return $code;
3329                   });
3330     }
3331
3332     if ($major < 5 && $^O eq 'aix'
3333         && !extract_from_file('pp_sys.c',
3334                               qr/defined\(HOST_NOT_FOUND\) && !defined\(h_errno\)/)) {
3335         # part of commit dc45a647708b6c54
3336         # Andy Dougherty's configuration patches (Config_63-01 up to 04).
3337         apply_patch(<<'EOPATCH')
3338 diff --git a/pp_sys.c b/pp_sys.c
3339 index c2fcb6f..efa39fb 100644
3340 --- a/pp_sys.c
3341 +++ b/pp_sys.c
3342 @@ -54,7 +54,7 @@ extern "C" int syscall(unsigned long,...);
3343  #endif
3344  #endif
3345
3346 -#ifdef HOST_NOT_FOUND
3347 +#if defined(HOST_NOT_FOUND) && !defined(h_errno)
3348  extern int h_errno;
3349  #endif
3350
3351 EOPATCH
3352     }
3353
3354     if ($major == 5
3355         && `git rev-parse HEAD` eq "22c35a8c2392967a5ba6b5370695be464bd7012c\n") {
3356         # Commit 22c35a8c2392967a is significant,
3357         # "phase 1 of somewhat major rearrangement of PERL_OBJECT stuff"
3358         # but doesn't build due to 2 simple errors. blead in this broken state
3359         # was merged to the cfgperl branch, and then these were immediately
3360         # corrected there. cfgperl (with the fixes) was merged back to blead.
3361         # The resultant rather twisty maze of commits looks like this:
3362
3363 =begin comment
3364
3365 * | |   commit 137225782c183172f360c827424b9b9f8adbef0e
3366 |\ \ \  Merge: 22c35a8 2a8ee23
3367 | |/ /  Author: Gurusamy Sarathy <gsar@cpan.org>
3368 | | |   Date:   Fri Oct 30 17:38:36 1998 +0000
3369 | | |
3370 | | |       integrate cfgperl tweaks into mainline
3371 | | |
3372 | | |       p4raw-id: //depot/perl@2144
3373 | | |
3374 | * | commit 2a8ee23279873759693fa83eca279355db2b665c
3375 | | | Author: Jarkko Hietaniemi <jhi@iki.fi>
3376 | | | Date:   Fri Oct 30 13:27:39 1998 +0000
3377 | | |
3378 | | |     There can be multiple yacc/bison errors.
3379 | | |
3380 | | |     p4raw-id: //depot/cfgperl@2143
3381 | | |
3382 | * | commit 93fb2ac393172fc3e2c14edb20b718309198abbc
3383 | | | Author: Jarkko Hietaniemi <jhi@iki.fi>
3384 | | | Date:   Fri Oct 30 13:18:43 1998 +0000
3385 | | |
3386 | | |     README.posix-bc update.
3387 | | |
3388 | | |     p4raw-id: //depot/cfgperl@2142
3389 | | |
3390 | * | commit 4ec43091e8e6657cb260b5e563df30aaa154effe
3391 | | | Author: Jarkko Hietaniemi <jhi@iki.fi>
3392 | | | Date:   Fri Oct 30 09:12:59 1998 +0000
3393 | | |
3394 | | |     #2133 fallout.
3395 | | |
3396 | | |     p4raw-id: //depot/cfgperl@2141
3397 | | |
3398 | * |   commit 134ca994cfefe0f613d43505a885e4fc2100b05c
3399 | |\ \  Merge: 7093112 22c35a8
3400 | |/ /  Author: Jarkko Hietaniemi <jhi@iki.fi>
3401 |/| |   Date:   Fri Oct 30 08:43:18 1998 +0000
3402 | | |
3403 | | |       Integrate from mainperl.
3404 | | |
3405 | | |       p4raw-id: //depot/cfgperl@2140
3406 | | |
3407 * | | commit 22c35a8c2392967a5ba6b5370695be464bd7012c
3408 | | | Author: Gurusamy Sarathy <gsar@cpan.org>
3409 | | | Date:   Fri Oct 30 02:51:39 1998 +0000
3410 | | |
3411 | | |     phase 1 of somewhat major rearrangement of PERL_OBJECT stuff
3412 | | |     (objpp.h is gone, embed.pl now does some of that); objXSUB.h
3413 | | |     should soon be automated also; the global variables that
3414 | | |     escaped the PL_foo conversion are now reined in; renamed
3415 | | |     MAGIC in regcomp.h to REG_MAGIC to avoid collision with the
3416 | | |     type of same name; duplicated lists of pp_things in various
3417 | | |     places is now gone; result has only been tested on win32
3418 | | |
3419 | | |     p4raw-id: //depot/perl@2133
3420
3421 =end comment
3422
3423 =cut
3424
3425         # and completely confuses git bisect (and at least me), causing it to
3426         # the bisect run to confidently return the wrong answer, an unrelated
3427         # commit on the cfgperl branch.
3428
3429         apply_commit('4ec43091e8e6657c');
3430     }
3431
3432     if ($major == 5
3433         && extract_from_file('pp_sys.c', qr/PERL_EFF_ACCESS_R_OK/)
3434         && !extract_from_file('pp_sys.c', qr/XXX Configure test needed for eaccess/)) {
3435         # Between 5ff3f7a4e03a6b10 and c955f1177b2e311d^
3436         # This is the meat of commit c955f1177b2e311d (without the other
3437         # indenting changes that would cause a conflict).
3438         # Without this 538 revisions won't build on (at least) Linux
3439         apply_patch(<<'EOPATCH');
3440 diff --git a/pp_sys.c b/pp_sys.c
3441 index d60c8dc..867dee4 100644
3442 --- a/pp_sys.c
3443 +++ b/pp_sys.c
3444 @@ -198,9 +198,18 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
3445  #   if defined(I_SYS_SECURITY)
3446  #       include <sys/security.h>
3447  #   endif
3448 -#   define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
3449 -#   define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
3450 -#   define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
3451 +    /* XXX Configure test needed for eaccess */
3452 +#   ifdef ACC_SELF
3453 +        /* HP SecureWare */
3454 +#       define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
3455 +#       define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
3456 +#       define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
3457 +#   else
3458 +        /* SCO */
3459 +#       define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK))
3460 +#       define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK))
3461 +#       define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK))
3462 +#   endif
3463  #endif
3464
3465  #if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF)
3466 EOPATCH
3467     }
3468
3469     if ($major == 5
3470         && extract_from_file('mg.c', qr/If we're still on top of the stack, pop us off/)
3471         && !extract_from_file('mg.c', qr/PL_savestack_ix -= popval/)) {
3472         # Fix up commit 455ece5e082708b1:
3473         # SSNEW() API for allocating memory on the savestack
3474         # Message-Id: <tqemtae338.fsf@puma.genscan.com>
3475         # Subject: [PATCH 5.005_51] (was: why SAVEDESTRUCTOR()...)
3476         apply_commit('3c8a44569607336e', 'mg.c');
3477     }
3478
3479     if ($major == 5) {
3480         if (extract_from_file('doop.c', qr/croak\(no_modify\);/)
3481             && extract_from_file('doop.c', qr/croak\(PL_no_modify\);/)) {
3482             # Whilst the log suggests that this would only fix 5 commits, in
3483             # practice this area of history is a complete tarpit, and git bisect
3484             # gets very confused by the skips in the middle of the back and
3485             # forth merging between //depot/perl and //depot/cfgperl
3486             apply_commit('6393042b638dafd3');
3487         }
3488
3489         # One error "fixed" with another:
3490         if (extract_from_file('pp_ctl.c',
3491                               qr/\Qstatic void *docatch_body _((void *o));\E/)) {
3492             apply_commit('5b51e982882955fe');
3493         }
3494         # Which is then fixed by this:
3495         if (extract_from_file('pp_ctl.c',
3496                               qr/\Qstatic void *docatch_body _((valist\E/)) {
3497             apply_commit('47aa779ee4c1a50e');
3498         }
3499
3500         if (extract_from_file('thrdvar.h', qr/PERLVARI\(Tprotect/)
3501             && !extract_from_file('embedvar.h', qr/PL_protect/)) {
3502             # Commit 312caa8e97f1c7ee didn't update embedvar.h
3503             apply_commit('e0284a306d2de082', 'embedvar.h');
3504         }
3505     }
3506
3507     if ($major == 5
3508         && extract_from_file('sv.c',
3509                              qr/PerlDir_close\(IoDIRP\((?:\(IO\*\))?sv\)\);/)
3510         && !(extract_from_file('toke.c',
3511                                qr/\QIoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL\E/)
3512              || extract_from_file('toke.c',
3513                                   qr/\QIoDIRP(datasv) = (DIR*)NULL;\E/))) {
3514         # Commit 93578b34124e8a3b, //depot/perl@3298
3515         # close directory handles properly when localized,
3516         # tweaked slightly by commit 1236053a2c722e2b,
3517         # add test case for change#3298
3518         #
3519         # The fix is the last part of:
3520         #
3521         # various fixes for clean build and test on win32; configpm broken,
3522         # needed to open myconfig.SH rather than myconfig; sundry adjustments
3523         # to bytecode stuff; tweaks to DYNAMIC_ENV_FETCH code to make it
3524         # work under win32; getenv_sv() changed to getenv_len() since SVs
3525         # aren't visible in the lower echelons; remove bogus exports from
3526         # config.sym; PERL_OBJECT-ness for C++ exception support; null out
3527         # IoDIRP in filter_del() or sv_free() will attempt to close it
3528         #
3529         # The changed code is modified subsequently by commit e0c198038146b7a4
3530         apply_commit('a6c403648ecd5cc7', 'toke.c');
3531     }
3532
3533     if ($major < 6 && $^O eq 'netbsd'
3534         && !extract_from_file('unixish.h',
3535                               qr/defined\(NSIG\).*defined\(__NetBSD__\)/)) {
3536         apply_patch(<<'EOPATCH')
3537 diff --git a/unixish.h b/unixish.h
3538 index 2a6cbcd..eab2de1 100644
3539 --- a/unixish.h
3540 +++ b/unixish.h
3541 @@ -89,7 +89,7 @@
3542   */
3543  /* #define ALTERNATE_SHEBANG "#!" / **/
3544
3545 -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
3546 +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
3547  # include <signal.h>
3548  #endif
3549
3550 EOPATCH
3551     }
3552
3553     if ($major == 7 && $^O eq 'aix' &&
3554         extract_from_file('ext/List/Util/Util.xs', qr/PUSHBLOCK/)
3555         && !extract_from_file('makedef.pl', qr/^Perl_cxinc/)) {
3556         # Need this to get List::Utils 1.03 and later to compile.
3557         # 1.03 also expects to call Perl_pp_rand. Commit d3632a54487acc5f
3558         # fixes this (for the unthreaded case), but it's not until 1.05,
3559         # two days later, that this is fixed properly.
3560         apply_commit('cbb96eed3f175499');
3561     }
3562
3563     if (($major >= 7 || $major <= 9) && $^O eq 'openbsd'
3564         && `uname -m` eq "sparc64\n"
3565         # added in 2000 by commit cb434fcc98ac25f5:
3566         && extract_from_file('regexec.c',
3567                              qr!/\* No need to save/restore up to this paren \*/!)
3568         # re-indented in 2006 by commit 95b2444054382532:
3569         && extract_from_file('regexec.c', qr/^\t\tCURCUR cc;$/)) {
3570         # Need to work around a bug in (at least) OpenBSD's 4.6's sparc64 #
3571         # compiler ["gcc (GCC) 3.3.5 (propolice)"]. Between commits
3572         # 3ec562b0bffb8b8b (2002) and 1a4fad37125bac3e^ (2005) the darling thing
3573         # fails to compile any code for the statement cc.oldcc = PL_regcc;
3574         #
3575         # If you refactor the code to "fix" that, or force the issue using set
3576         # in the debugger, the stack smashing detection code fires on return
3577         # from S_regmatch(). Turns out that the compiler doesn't allocate any
3578         # (or at least enough) space for cc.
3579         #
3580         # Restore the "uninitialised" value for cc before function exit, and the
3581         # stack smashing code is placated.  "Fix" 3ec562b0bffb8b8b (which
3582         # changes the size of auto variables used elsewhere in S_regmatch), and
3583         # the crash is visible back to bc517b45fdfb539b (which also changes
3584         # buffer sizes). "Unfix" 1a4fad37125bac3e and the crash is visible until
3585         # 5b47454deb66294b.  Problem goes away if you compile with -O, or hack
3586         # the code as below.
3587         #
3588         # Hence this turns out to be a bug in (old) gcc. Not a security bug we
3589         # still need to fix.
3590         apply_patch(<<'EOPATCH');
3591 diff --git a/regexec.c b/regexec.c
3592 index 900b491..6251a0b 100644
3593 --- a/regexec.c
3594 +++ b/regexec.c
3595 @@ -2958,7 +2958,11 @@ S_regmatch(pTHX_ regnode *prog)
3596                                 I,I
3597   *******************************************************************/
3598         case CURLYX: {
3599 -               CURCUR cc;
3600 +           union {
3601 +               CURCUR hack_cc;
3602 +               char hack_buff[sizeof(CURCUR) + 1];
3603 +           } hack;
3604 +#define cc hack.hack_cc
3605                 CHECKPOINT cp = PL_savestack_ix;
3606                 /* No need to save/restore up to this paren */
3607                 I32 parenfloor = scan->flags;
3608 @@ -2983,6 +2987,7 @@ S_regmatch(pTHX_ regnode *prog)
3609                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
3610                 regcpblow(cp);
3611                 PL_regcc = cc.oldcc;
3612 +#undef cc
3613                 saySAME(n);
3614             }
3615             /* NOT REACHED */
3616 EOPATCH
3617 }
3618
3619     if ($major < 8 && $^O eq 'openbsd'
3620         && !extract_from_file('perl.h', qr/include <unistd\.h>/)) {
3621         # This is part of commit 3f270f98f9305540, applied at a slightly
3622         # different location in perl.h, where the context is stable back to
3623         # 5.000
3624         apply_patch(<<'EOPATCH');
3625 diff --git a/perl.h b/perl.h
3626 index 9418b52..b8b1a7c 100644
3627 --- a/perl.h
3628 +++ b/perl.h
3629 @@ -496,6 +496,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
3630  #   include <sys/param.h>
3631  #endif
3632
3633 +/* If this causes problems, set i_unistd=undef in the hint file.  */
3634 +#ifdef I_UNISTD
3635 +#   include <unistd.h>
3636 +#endif
3637
3638  /* Use all the "standard" definitions? */
3639  #if defined(STANDARD_C) && defined(I_STDLIB)
3640 EOPATCH
3641     }
3642 }
3643
3644 sub patch_ext {
3645     if (-f 'ext/POSIX/Makefile.PL'
3646         && extract_from_file('ext/POSIX/Makefile.PL',
3647                              qr/Explicitly avoid including/)) {
3648         # commit 6695a346c41138df, which effectively reverts 170888cff5e2ffb7
3649
3650         # PERL5LIB is populated by make_ext.pl with paths to the modules we need
3651         # to run, don't override this with "../../lib" since that may not have
3652         # been populated yet in a parallel build.
3653         apply_commit('6695a346c41138df');
3654     }
3655
3656     if (-f 'ext/Hash/Util/Makefile.PL'
3657         && extract_from_file('ext/Hash/Util/Makefile.PL',
3658                              qr/\bDIR\b.*'FieldHash'/)) {
3659         # ext/Hash/Util/Makefile.PL should not recurse to FieldHash's Makefile.PL
3660         # *nix, VMS and Win32 all know how to (and have to) call the latter directly.
3661         # As is, targets in ext/Hash/Util/FieldHash get called twice, which may result
3662         # in race conditions, and certainly messes up make clean; make distclean;
3663         apply_commit('550428fe486b1888');
3664     }
3665
3666     if ($major < 8 && $^O eq 'darwin' && !-f 'ext/DynaLoader/dl_dyld.xs') {
3667         checkout_file('ext/DynaLoader/dl_dyld.xs', 'f556e5b971932902');
3668         apply_patch(<<'EOPATCH');
3669 diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
3670 --- a/ext/DynaLoader/dl_dyld.xs~        2011-10-11 21:41:27.000000000 +0100
3671 +++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:42:20.000000000 +0100
3672 @@ -41,6 +41,35 @@
3673  #include "perl.h"
3674  #include "XSUB.h"
3675
3676 +#ifndef pTHX
3677 +#  define pTHX         void
3678 +#  define pTHX_
3679 +#endif
3680 +#ifndef aTHX
3681 +#  define aTHX
3682 +#  define aTHX_
3683 +#endif
3684 +#ifndef dTHX
3685 +#  define dTHXa(a)     extern int Perl___notused(void)
3686 +#  define dTHX         extern int Perl___notused(void)
3687 +#endif
3688 +
3689 +#ifndef Perl_form_nocontext
3690 +#  define Perl_form_nocontext form
3691 +#endif
3692 +
3693 +#ifndef Perl_warn_nocontext
3694 +#  define Perl_warn_nocontext warn
3695 +#endif
3696 +
3697 +#ifndef PTR2IV
3698 +#  define PTR2IV(p)    (IV)(p)
3699 +#endif
3700 +
3701 +#ifndef get_av
3702 +#  define get_av perl_get_av
3703 +#endif
3704 +
3705  #define DL_LOADONCEONLY
3706
3707  #include "dlutils.c"   /* SaveError() etc      */
3708 @@ -185,7 +191,7 @@
3709      CODE:
3710      DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
3711      if (flags & 0x01)
3712 -       Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
3713 +       Perl_warn_nocontext("Can't make loaded symbols global on this platform while loading %s",filename);
3714      RETVAL = dlopen(filename, mode) ;
3715      DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
3716      ST(0) = sv_newmortal() ;
3717 EOPATCH
3718         if ($major < 4 && !extract_from_file('util.c', qr/^form/m)) {
3719             apply_patch(<<'EOPATCH');
3720 diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
3721 --- a/ext/DynaLoader/dl_dyld.xs~        2011-10-11 21:56:25.000000000 +0100
3722 +++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 22:00:00.000000000 +0100
3723 @@ -60,6 +60,18 @@
3724  #  define get_av perl_get_av
3725  #endif
3726
3727 +static char *
3728 +form(char *pat, ...)
3729 +{
3730 +    char *retval;
3731 +    va_list args;
3732 +    va_start(args, pat);
3733 +    vasprintf(&retval, pat, &args);
3734 +    va_end(args);
3735 +    SAVEFREEPV(retval);
3736 +    return retval;
3737 +}
3738 +
3739  #define DL_LOADONCEONLY
3740
3741  #include "dlutils.c"   /* SaveError() etc      */
3742 EOPATCH
3743         }
3744     }
3745
3746     if ($major < 10) {
3747         if ($unfixable_db_file) {
3748             # Nothing we can do.
3749         } elsif (!extract_from_file('ext/DB_File/DB_File.xs',
3750                                     qr/^#ifdef AT_LEAST_DB_4_1$/)) {
3751             # This line is changed by commit 3245f0580c13b3ab
3752             my $line = extract_from_file('ext/DB_File/DB_File.xs',
3753                                          qr/^(        status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/);
3754             apply_patch(<<"EOPATCH");
3755 diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
3756 index 489ba96..fba8ded 100644
3757 --- a/ext/DB_File/DB_File.xs
3758 +++ b/ext/DB_File/DB_File.xs
3759 \@\@ -183,4 +187,8 \@\@
3760  #endif
3761
3762 +#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
3763 +#    define AT_LEAST_DB_4_1
3764 +#endif
3765 +
3766  /* map version 2 features & constants onto their version 1 equivalent */
3767
3768 \@\@ -1334,7 +1419,12 \@\@ SV *   sv ;
3769  #endif
3770
3771 +#ifdef AT_LEAST_DB_4_1
3772 +        status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
3773 +                               Flags, mode) ;
3774 +#else
3775  $line
3776                                 Flags, mode) ;
3777 +#endif
3778         /* printf("open returned %d %s\\n", status, db_strerror(status)) ; */
3779
3780 EOPATCH
3781         }
3782     }
3783
3784     if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') {
3785         edit_file('ext/IPC/SysV/SysV.xs', sub {
3786                       my $xs = shift;
3787                       my $fixed = <<'EOFIX';
3788
3789 #include <sys/types.h>
3790 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3791 #ifndef HAS_SEM
3792 #   include <sys/ipc.h>
3793 #endif
3794 #   ifdef HAS_MSG
3795 #       include <sys/msg.h>
3796 #   endif
3797 #   ifdef HAS_SHM
3798 #       if defined(PERL_SCO) || defined(PERL_ISC)
3799 #           include <sys/sysmacros.h>   /* SHMLBA */
3800 #       endif
3801 #      include <sys/shm.h>
3802 #      ifndef HAS_SHMAT_PROTOTYPE
3803            extern Shmat_t shmat (int, char *, int);
3804 #      endif
3805 #      if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
3806 #          undef  SHMLBA /* not static: determined at boot time */
3807 #          define SHMLBA sysconf(_SC_PAGESIZE)
3808 #      elif defined(HAS_GETPAGESIZE)
3809 #          undef  SHMLBA /* not static: determined at boot time */
3810 #          define SHMLBA getpagesize()
3811 #      endif
3812 #   endif
3813 #endif
3814 EOFIX
3815                       $xs =~ s!
3816 #include <sys/types\.h>
3817 .*
3818 (#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms;
3819                       return $xs;
3820                   });
3821     }
3822 }
3823
3824 sub apply_fixups {
3825     my $fixups = shift;
3826     return unless $fixups;
3827     foreach my $file (@$fixups) {
3828         my $fh = open_or_die($file);
3829         my $line = <$fh>;
3830         close_or_die($fh);
3831         if ($line =~ /^#!perl\b/) {
3832             system $^X, $file
3833                 and die_255("$^X $file failed: \$!=$!, \$?=$?");
3834         } elsif ($line =~ /^#!(\/\S+)/) {
3835             system $file
3836                 and die_255("$file failed: \$!=$!, \$?=$?");
3837         } else {
3838             if (my ($target, $action, $pattern)
3839                 = $line =~ m#^(\S+) ([=!])~ /(.*)/#) {
3840                 if (length $pattern) {
3841                     next unless -f $target;
3842                     if ($action eq '=') {
3843                         next unless extract_from_file($target, $pattern);
3844                     } else {
3845                         next if extract_from_file($target, $pattern);
3846                     }
3847                 } else {
3848                     # Avoid the special case meaning of the empty pattern,
3849                     # and instead use this to simply test for the file being
3850                     # present or absent
3851                     if ($action eq '=') {
3852                         next unless -f $target;
3853                     } else {
3854                         next if -f $target;
3855                     }
3856                 }
3857             }
3858             system_or_die("patch -p1 <$file");
3859         }
3860     }
3861 }
3862
3863 # ex: set ts=8 sts=4 sw=4 et: