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