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