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 Carp;
   8
   9 my @targets
  10     = qw(config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep);
  11
  12 my $cpus;
  13 if (open my $fh, '<', '/proc/cpuinfo') {
  14     while (<$fh>) {
  15         ++$cpus if /^processor\s+:\s+\d+$/;
  16     }
  17 } elsif (-x '/sbin/sysctl') {
  18     $cpus = 1 + $1 if `/sbin/sysctl hw.ncpu` =~ /^hw\.ncpu: (\d+)$/;
  19 } elsif (-x '/usr/bin/getconf') {
  20     $cpus = 1 + $1 if `/usr/bin/getconf _NPROCESSORS_ONLN` =~ /^(\d+)$/;
  21 }
  22
  23 my %options =
  24     (
  25      jobs => defined $cpus ? $cpus + 1 : 2,
  26      'expect-pass' => 1,
  27      clean => 1, # mostly for debugging this
  28     );
  29
  30 my $linux64 = `uname -sm` eq "Linux x86_64\n" ? '64' : '';
  31
  32 my @paths;
  33
  34 if ($^O eq 'linux') {
  35     # This is the search logic for a multi-arch library layout
  36     # added to linux.sh in commits 40f026236b9959b7 and dcffd848632af2c7.
  37     my $gcc = -x '/usr/bin/gcc' ? '/usr/bin/gcc' : 'gcc';
  38
  39     foreach (`$gcc -print-search-dirs`) {
  40         next unless /^libraries: =(.*)/;
  41         foreach (split ':', $1) {
  42             next if m/gcc/;
  43             next unless -d $_;
  44             s!/$!!;
  45             push @paths, $_;
  46         }
  47     }
  48 }
  49
  50 push @paths, map {$_ . $linux64} qw(/usr/local/lib /lib /usr/lib);
  51
  52 my %defines =
  53     (
  54      usedevel => '',
  55      optimize => '-g',
  56      cc => (`ccache --version`, $?) ? 'cc' : 'ccache cc',
  57      ld => 'cc',
  58      ($linux64 ? (libpth => \@paths) : ()),
  59     );
  60
  61 unless(GetOptions(\%options,
  62                   'target=s', 'jobs|j=i', 'expect-pass=i',
  63                   'expect-fail' => sub { $options{'expect-pass'} = 0; },
  64                   'clean!', 'one-liner|e=s', 'match=s', 'force-manifest',
  65                   'force-regen', 'test-build', 'A=s@', 'l', 'w',
  66                   'check-args', 'check-shebang!', 'usage|help|?',
  67                   'D=s@' => sub {
  68                       my (undef, $val) = @_;
  69                       if ($val =~ /\A([^=]+)=(.*)/s) {
  70                           $defines{$1} = length $2 ? $2 : "\0";
  71                       } else {
  72                           $defines{$val} = '';
  73                       }
  74                   },
  75                   'U=s@' => sub {
  76                       $defines{$_[1]} = undef;
  77                   },
  78                  )) {
  79     pod2usage(exitval => 255, verbose => 1);
  80 }
  81
  82 my ($target, $j, $match) = @options{qw(target jobs match)};
  83
  84 pod2usage(exitval => 255, verbose => 1) if $options{usage};
  85 pod2usage(exitval => 255, verbose => 1)
  86     unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'};
  87 pod2usage(exitval => 255, verbose => 1)
  88     if !$options{'one-liner'} && ($options{l} || $options{w});
  89
  90 check_shebang($ARGV[0]) if $options{'check-shebang'} && @ARGV;
  91
  92 exit 0 if $options{'check-args'};
  93
  94 =head1 NAME
  95
  96 bisect.pl - use git bisect to pinpoint changes
  97
  98 =head1 SYNOPSIS
  99
 100     # When did this become an error?
 101     .../Porting/bisect.pl -e 'my $a := 2;'
 102     # When did this stop being an error?
 103     .../Porting/bisect.pl --expect-fail -e '1 // 2'
 104     # When did this stop matching?
 105     .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b'
 106     # When did this start matching?
 107     .../Porting/bisect.pl --expect-fail --match '\buseithreads\b'
 108     # When did this test program stop working?
 109     .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl
 110     # When did this first become valid syntax?
 111     .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \
 112          --expect-fail -e 'my $a := 2;'
 113     # What was the last revision to build with these options?
 114     .../Porting/bisect.pl --test-build -Dd_dosuid
 115
 116 =head1 DESCRIPTION
 117
 118 Together F<bisect.pl> and F<bisect-runner.pl> attempt to automate the use
 119 of C<git bisect> as much as possible. With one command (and no other files)
 120 it's easy to find out
 121
 122 =over 4
 123
 124 =item *
 125
 126 Which commit caused this example code to break?
 127
 128 =item *
 129
 130 Which commit caused this example code to start working?
 131
 132 =item *
 133
 134 Which commit added the first to match this regex?
 135
 136 =item *
 137
 138 Which commit removed the last to match this regex?
 139
 140 =back
 141
 142 usually without needing to know which versions of perl to use as start and
 143 end revisions.
 144
 145 By default F<bisect.pl> will process all options, then use the rest of the
 146 command line as arguments to list C<system> to run a test case. By default,
 147 the test case should pass (exit with 0) on earlier perls, and fail (exit
 148 non-zero) on I<blead>. F<bisect.pl> will use F<bisect-runner.pl> to find the
 149 earliest stable perl version on which the test case passes, check that it
 150 fails on blead, and then use F<bisect-runner.pl> with C<git bisect run> to
 151 find the commit which caused the failure.
 152
 153 Because the test case is the complete argument to C<system>, it is easy to
 154 run something other than the F<perl> built, if necessary. If you need to run
 155 the perl built, you'll probably need to invoke it as C<./perl -Ilib ...>
 156
 157 You need a clean checkout to run a bisect, and you can't use the checkout
 158 which contains F<Porting/bisect.pl> (because C<git bisect>) will check out
 159 a revision before F<Porting/bisect-runner.pl> was added, which
 160 C<git bisect run> needs). If your working checkout is called F<perl>, the
 161 simplest solution is to make a local clone, and run from that. I<i.e.>:
 162
 163     cd ..
 164     git clone perl perl2
 165     cd perl2
 166     ../perl/Porting/bisect.pl ...
 167
 168 By default, F<bisect-runner.pl> will automatically disable the build of
 169 L<DB_File> for commits earlier than ccb44e3bf3be2c30, as it's not practical
 170 to patch DB_File 1.70 and earlier to build with current Berkeley DB headers.
 171 (ccb44e3bf3be2c30 was in September 1999, between 5.005_62 and 5.005_63.)
 172 If your F<db.h> is old enough you can override this with C<-Unoextensions>.
 173
 174 =head1 OPTIONS
 175
 176 =over 4
 177
 178 =item *
 179
 180 --start I<commit-ish>
 181
 182 Earliest revision to test, as a I<commit-ish> (a tag, commit or anything
 183 else C<git> understands as a revision). If not specified, F<bisect.pl> will
 184 search stable perl releases from 5.002 to 5.14.0 until it finds one where
 185 the test case passes.
 186
 187 =item *
 188
 189 --end I<commit-ish>
 190
 191 Most recent revision to test, as a I<commit-ish>. If not specified, defaults
 192 to I<blead>.
 193
 194 =item *
 195
 196 --target I<target>
 197
 198 F<Makefile> target (or equivalent) needed, to run the test case. If specified,
 199 this should be one of
 200
 201 =over 4
 202
 203 =item *
 204
 205 I<config.sh>
 206
 207 Just run F<./Configure>
 208
 209 =item *
 210
 211 I<config.h>
 212
 213 Run the various F<*.SH> files to generate F<Makefile>, F<config.h>, I<etc>.
 214
 215 =item *
 216
 217 I<miniperl>
 218
 219 Build F<miniperl>.
 220
 221 =item *
 222
 223 I<lib/Config.pm>
 224
 225 Use F<miniperl> to build F<lib/Config.pm>
 226
 227 =item *
 228
 229 I<Fcntl>
 230
 231 Build F<lib/auto/Fcntl/Fnctl.so> (strictly, C<.$Config{so}>). As L<Fcntl>
 232 is simple XS module present since 5.000, this provides a fast test of
 233 whether XS modules can be built. Note, XS modules are built by F<miniperl>,
 234 hence this target will not build F<perl>.
 235
 236 =item *
 237
 238 I<perl>
 239
 240 Build F<perl>. This also builds pure-Perl modules in F<cpan>, F<dist> and
 241 F<ext>. XS modules (such as L<Fcntl>) are not built.
 242
 243 =item *
 244
 245 I<test_prep>
 246
 247 Build everything needed to run the tests. This is the default if we're
 248 running test code, but is time consuming, as it means building all
 249 XS modules. For older F<Makefile>s, the previous name of C<test-prep>
 250 is automatically substituted. For very old F<Makefile>s, C<make test> is
 251 run, as there is no target provided to just get things ready, and for 5.004
 252 and earlier the tests run very quickly.
 253
 254 =back
 255
 256 =item *
 257
 258 --one-liner 'code to run'
 259
 260 =item *
 261
 262 -e 'code to run'
 263
 264 Example code to run, just like you'd use with C<perl -e>.
 265
 266 This prepends C<./perl -Ilib -e 'code to run'> to the test case given,
 267 or F<./miniperl> if I<target> is C<miniperl>.
 268
 269 (Usually you'll use C<-e> instead of providing a test case in the
 270 non-option arguments to F<bisect.pl>)
 271
 272 C<-E> intentionally isn't supported, as it's an error in 5.8.0 and earlier,
 273 which interferes with detecting errors in the example code itself.
 274
 275 =item *
 276
 277 -l
 278
 279 Add C<-l> to the command line with C<-e>
 280
 281 This will automatically append a newline to every output line of your testcase.
 282 Note that you can't specify an argument to F<perl>'s C<-l> with this, as it's
 283 not feasible to emulate F<perl>'s somewhat quirky switch parsing with
 284 L<Getopt::Long>. If you need the full flexibility of C<-l>, you need to write
 285 a full test case, instead of using C<bisect.pl>'s C<-e> shortcut.
 286
 287 =item *
 288
 289 -w
 290
 291 Add C<-w> to the command line with C<-e>
 292
 293 It's not valid to pass C<-l> or C<-w> to C<bisect.pl> unless you are also
 294 using C<-e>
 295
 296 =item *
 297
 298 --expect-fail
 299
 300 The test case should fail for the I<start> revision, and pass for the I<end>
 301 revision. The bisect run will find the first commit where it passes.
 302
 303 =item *
 304
 305 -Dnoextensions=Encode
 306
 307 =item *
 308
 309 -Uusedevel
 310
 311 =item *
 312
 313 -Accflags=-DNO_MATHOMS
 314
 315 Arguments to pass to F<Configure>. Repeated C<-A> arguments are passed
 316 through as is. C<-D> and C<-U> are processed in order, and override
 317 previous settings for the same parameter. F<bisect-runner.pl> emulates
 318 C<-Dnoextensions> when F<Configure> itself does not provide it, as it's
 319 often very useful to be able to disable some XS extensions.
 320
 321 =item *
 322
 323 --jobs I<jobs>
 324
 325 =item *
 326
 327 -j I<jobs>
 328
 329 Number of C<make> jobs to run in parallel. If F</proc/cpuinfo> exists and
 330 can be parsed, or F</sbin/sysctl> exists and reports C<hw.ncpu>, or
 331 F</usr/bin/getconf> exists and reports C<_NPROCESSORS_ONLN> defaults to 1 +
 332 I<number of CPUs>. Otherwise defaults to 2.
 333
 334 =item *
 335
 336 --match pattern
 337
 338 Instead of running a test program to determine I<pass> or I<fail>, pass
 339 if the given regex matches, and hence search for the commit that removes
 340 the last matching file.
 341
 342 If no I<target> is specified, the match is against all files in the
 343 repository (which is fast). If a I<target> is specified, that target is
 344 built, and the match is against only the built files. C<--expect-fail> can
 345 be used with C<--match> to search for a commit that adds files that match.
 346
 347 =item *
 348
 349 --test-build
 350
 351 Test that the build completes, without running any test case.
 352
 353 By default, if the build for the desired I<target> fails to complete,
 354 F<bisect-runner.pl> reports a I<skip> back to C<git bisect>, the assumption
 355 being that one wants to find a commit which changed state "builds && passes"
 356 to "builds && fails". If instead one is interested in which commit broke the
 357 build (possibly for particular F<Configure> options), use I<--test-build>
 358 to treat a build failure as a failure, not a "skip".
 359
 360 Often this option isn't as useful as it first seems, because I<any> build
 361 failure will be reported to C<git bisect> as a failure, not just the failure
 362 that you're interested in. Generally, to debug a particular problem, it's
 363 more useful to use a I<target> that builds properly at the point of interest,
 364 and then a test case that runs C<make>. For example:
 365
 366     .../Porting/bisect.pl --start=perl-5.000 --end=perl-5.002 \
 367         --expect-fail --force-manifest --target=miniperl make perl
 368
 369 will find the first revision capable of building L<DynaLoader> and then
 370 F<perl>, without becoming confused by revisions where F<miniperl> won't
 371 even link.
 372
 373 =item *
 374
 375 --force-manifest
 376
 377 By default, a build will "skip" if any files listed in F<MANIFEST> are not
 378 present. Usually this is useful, as it avoids false-failures. However, there
 379 are some long ranges of commits where listed files are missing, which can
 380 cause a bisect to abort because all that remain are skipped revisions.
 381
 382 In these cases, particularly if the test case uses F<miniperl> and no modules,
 383 it may be more useful to force the build to continue, even if files
 384 F<MANIFEST> are missing.
 385
 386 =item *
 387
 388 --force-regen
 389
 390 Run C<make regen_headers> before building F<miniperl>. This may fix a build
 391 that otherwise would skip because the generated headers at that revision
 392 are stale. It's not the default because it conceals this error in the true
 393 state of such revisions.
 394
 395 =item *
 396
 397 --expect-pass [0|1]
 398
 399 C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1> is the default.
 400
 401 =item *
 402
 403 --no-clean
 404
 405 Tell F<bisect-runner.pl> not to clean up after the build. This allows one
 406 to use F<bisect-runner.pl> to build the current particular perl revision for
 407 interactive testing, or for debugging F<bisect-runner.pl>.
 408
 409 Passing this to F<bisect.pl> will likely cause the bisect to fail badly.
 410
 411 =item *
 412
 413 --validate
 414
 415 Test that all stable revisions can be built. By default, attempts to build
 416 I<blead>, I<v5.14.0> .. I<perl-5.002>. Stops at the first failure, without
 417 cleaning the checkout. Use I<--start> to specify the earliest revision to
 418 test, I<--end> to specify the most recent. Useful for validating a new
 419 OS/CPU/compiler combination. For example
 420
 421     ../perl/Porting/bisect.pl --validate -le 'print "Hello from $]"'
 422
 423 If no testcase is specified, the default is to use F<t/TEST> to run
 424 F<t/base/*.t>
 425
 426 =item *
 427
 428 --check-args
 429
 430 Validate the options and arguments, and exit silently if they are valid.
 431
 432 =item *
 433
 434 --check-shebang
 435
 436 Validate that the test case isn't an executable file with a
 437 C<#!/usr/bin/perl> line (or similar). As F<bisect-runner.pl> does B<not>
 438 prepend C<./perl> to the test case, a I<#!> line specifying an external
 439 F<perl> binary will cause the test case to always run with I<that> F<perl>,
 440 not the F<perl> built by the bisect runner. Likely this is not what you
 441 wanted. If your test case is actually a wrapper script to run other
 442 commands, you should run it with an explicit interpreter, to be clear. For
 443 example, instead of C<../perl/Porting/bisect.pl ~/test/testcase.pl> you'd
 444 run C<../perl/Porting/bisect.pl /usr/bin/perl ~/test/testcase.pl>
 445
 446 =item *
 447
 448 --usage
 449
 450 =item *
 451
 452 --help
 453
 454 =item *
 455
 456 -?
 457
 458 Display the usage information and exit.
 459
 460 =back
 461
 462 =cut
 463
 464 die "$0: Can't build $target" if defined $target && !grep {@targets} $target;
 465
 466 $j = "-j$j" if $j =~ /\A\d+\z/;
 467
 468 # Sadly, however hard we try, I don't think that it will be possible to build
 469 # modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29,
 470 # which updated to MakeMaker 3.7, which changed from using a hard coded ld
 471 # in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc.
 472
 473 sub open_or_die {
 474     my $file = shift;
 475     my $mode = @_ ? shift : '<';
 476     open my $fh, $mode, $file or croak("Can't open $file: $!");
 477     ${*$fh{SCALAR}} = $file;
 478     return $fh;
 479 }
 480
 481 sub close_or_die {
 482     my $fh = shift;
 483     return if close $fh;
 484     croak("Can't close: $!") unless ref $fh eq 'GLOB';
 485     croak("Can't close ${*$fh{SCALAR}}: $!");
 486 }
 487
 488 sub extract_from_file {
 489     my ($file, $rx, $default) = @_;
 490     my $fh = open_or_die($file);
 491     while (<$fh>) {
 492         my @got = $_ =~ $rx;
 493         return wantarray ? @got : $got[0]
 494             if @got;
 495     }
 496     return $default if defined $default;
 497     return;
 498 }
 499
 500 sub edit_file {
 501     my ($file, $munger) = @_;
 502     local $/;
 503     my $fh = open_or_die($file);
 504     my $orig = <$fh>;
 505     die "Can't read $file: $!" unless defined $orig && close $fh;
 506     my $new = $munger->($orig);
 507     return if $new eq $orig;
 508     $fh = open_or_die($file, '>');
 509     print $fh $new or die "Can't print to $file: $!";
 510     close_or_die($fh);
 511 }
 512
 513 sub apply_patch {
 514     my $patch = shift;
 515
 516     my ($file) = $patch =~ qr!^--- a/(\S+)\n\+\+\+ b/\1!sm;
 517     open my $fh, '|-', 'patch', '-p1' or die "Can't run patch: $!";
 518     print $fh $patch;
 519     return if close $fh;
 520     print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n";
 521     die "Can't patch $file: $?, $!";
 522 }
 523
 524 sub apply_commit {
 525     my ($commit, @files) = @_;
 526     return unless system "git show $commit @files | patch -p1";
 527     die "Can't apply commit $commit to @files" if @files;
 528     die "Can't apply commit $commit";
 529 }
 530
 531 sub revert_commit {
 532     my ($commit, @files) = @_;
 533     return unless system "git show -R $commit @files | patch -p1";
 534     die "Can't apply revert $commit from @files" if @files;
 535     die "Can't apply revert $commit";
 536 }
 537
 538 sub checkout_file {
 539     my ($file, $commit) = @_;
 540     $commit ||= 'blead';
 541     system "git show $commit:$file > $file </dev/null"
 542         and die "Could not extract $file at revision $commit";
 543 }
 544
 545 sub check_shebang {
 546     my $file = shift;
 547     return unless -e $file;
 548     if (!-x $file) {
 549         die "$file is not executable.
 550 system($file, ...) is always going to fail.
 551
 552 Bailing out";
 553     }
 554     my $fh = open_or_die($file);
 555     my $line = <$fh>;
 556     return unless $line =~ m{\A#!(/\S+/perl\S*)\s};
 557     die "$file will always be run by $1
 558 It won't be tested by the ./perl we build.
 559 If you intended to run it with that perl binary, please change your
 560 test case to
 561
 562     $1 @ARGV
 563
 564 If you intended to test it with the ./perl we build, please change your
 565 test case to
 566
 567     ./perl -Ilib @ARGV
 568
 569 [You may also need to add -- before ./perl to prevent that -Ilib as being
 570 parsed as an argument to bisect.pl]
 571
 572 Bailing out";
 573 }
 574
 575 sub clean {
 576     if ($options{clean}) {
 577         # Needed, because files that are build products in this checked out
 578         # version might be in git in the next desired version.
 579         system 'git clean -dxf </dev/null';
 580         # Needed, because at some revisions the build alters checked out files.
 581         # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
 582         system 'git reset --hard HEAD </dev/null';
 583     }
 584 }
 585
 586 sub skip {
 587     my $reason = shift;
 588     clean();
 589     warn "skipping - $reason";
 590     exit 125;
 591 }
 592
 593 sub report_and_exit {
 594     my ($ret, $pass, $fail, $desc) = @_;
 595
 596     clean();
 597
 598     my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad';
 599     if ($ret) {
 600         print "$got - $fail $desc\n";
 601     } else {
 602         print "$got - $pass $desc\n";
 603     }
 604
 605     exit($got eq 'bad');
 606 }
 607
 608 sub match_and_exit {
 609     my $target = shift;
 610     my $matches = 0;
 611     my $re = qr/$match/;
 612     my @files;
 613
 614     {
 615         local $/ = "\0";
 616         @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`;
 617         chomp @files;
 618     }
 619
 620     foreach my $file (@files) {
 621         my $fh = open_or_die($file);
 622         while (<$fh>) {
 623             if ($_ =~ $re) {
 624                 ++$matches;
 625                 if (tr/\t\r\n -~\200-\377//c) {
 626                     print "Binary file $file matches\n";
 627                 } else {
 628                     $_ .= "\n" unless /\n\z/;
 629                     print "$file: $_";
 630                 }
 631             }
 632         }
 633         close_or_die($fh);
 634     }
 635     report_and_exit(!$matches,
 636                     $matches == 1 ? '1 match for' : "$matches matches for",
 637                     'no matches for', $match);
 638 }
 639
 640 # Not going to assume that system perl is yet new enough to have autodie
 641 system 'git clean -dxf </dev/null' and die;
 642
 643 if (!defined $target) {
 644     match_and_exit() if $match;
 645     $target = 'test_prep';
 646 }
 647
 648 skip('no Configure - is this the //depot/perlext/Compiler branch?')
 649     unless -f 'Configure';
 650
 651 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
 652 my $major
 653     = extract_from_file('patchlevel.h',
 654                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
 655                         0);
 656
 657 patch_Configure();
 658 patch_hints();
 659
 660 # if Encode is not needed for the test, you can speed up the bisect by
 661 # excluding it from the runs with -Dnoextensions=Encode
 662 # ccache is an easy win. Remove it if it causes problems.
 663 # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
 664 # to true in hints/linux.sh
 665 # On dromedary, from that point on, Configure (by default) fails to find any
 666 # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
 667 # versioned libraries. Without -lm, the build fails.
 668 # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
 669 # until commit faae14e6e968e1c0 adds it to the hints.
 670 # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
 671 # because it will spot versioned libraries, pass them to the compiler, and then
 672 # bail out pretty early on. Configure won't let us override libswanted, but it
 673 # will let us override the entire libs list.
 674
 675 unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
 676     # Before 1cfa4ec74d4933da, so force the libs list.
 677
 678     my @libs;
 679     # This is the current libswanted list from Configure, less the libs removed
 680     # by current hints/linux.sh
 681     foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
 682                         ld sun m crypt sec util c cposix posix ucb BSD)) {
 683         foreach my $dir (@paths) {
 684             next unless -f "$dir/lib$lib.so";
 685             push @libs, "-l$lib";
 686             last;
 687         }
 688     }
 689     $defines{libs} = \@libs unless exists $defines{libs};
 690 }
 691
 692 $defines{usenm} = undef
 693     if $major < 2 && !exists $defines{usenm};
 694
 695 my ($missing, $created_dirs);
 696 ($missing, $created_dirs) = force_manifest()
 697     if $options{'force-manifest'};
 698
 699 my @ARGS = '-dEs';
 700 foreach my $key (sort keys %defines) {
 701     my $val = $defines{$key};
 702     if (ref $val) {
 703         push @ARGS, "-D$key=@$val";
 704     } elsif (!defined $val) {
 705         push @ARGS, "-U$key";
 706     } elsif (!length $val) {
 707         push @ARGS, "-D$key";
 708     } else {
 709         $val = "" if $val eq "\0";
 710         push @ARGS, "-D$key=$val";
 711     }
 712 }
 713 push @ARGS, map {"-A$_"} @{$options{A}};
 714
 715 # </dev/null because it seems that some earlier versions of Configure can
 716 # call commands in a way that now has them reading from stdin (and hanging)
 717 my $pid = fork;
 718 die "Can't fork: $!" unless defined $pid;
 719 if (!$pid) {
 720     open STDIN, '<', '/dev/null';
 721     # If a file in MANIFEST is missing, Configure asks if you want to
 722     # continue (the default being 'n'). With stdin closed or /dev/null,
 723     # it exits immediately and the check for config.sh below will skip.
 724     exec './Configure', @ARGS;
 725     die "Failed to start Configure: $!";
 726 }
 727 waitpid $pid, 0
 728     or die "wait for Configure, pid $pid failed: $!";
 729
 730 patch_SH();
 731
 732 if (-f 'config.sh') {
 733     # Emulate noextensions if Configure doesn't support it.
 734     fake_noextensions()
 735         if $major < 10 && $defines{noextensions};
 736     system './Configure -S </dev/null' and die;
 737 }
 738
 739 if ($target =~ /config\.s?h/) {
 740     match_and_exit($target) if $match && -f $target;
 741     report_and_exit(!-f $target, 'could build', 'could not build', $target)
 742         if $options{'test-build'};
 743
 744     my $ret = system @ARGV;
 745     report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
 746 } elsif (!-f 'config.sh') {
 747     # Skip if something went wrong with Configure
 748
 749     skip('could not build config.sh');
 750 }
 751
 752 force_manifest_cleanup($missing, $created_dirs)
 753         if $missing;
 754
 755 if($options{'force-regen'}
 756    && extract_from_file('Makefile', qr/\bregen_headers\b/)) {
 757     # regen_headers was added in e50aee73b3d4c555, patch.1m for perl5.001
 758     # It's not worth faking it for earlier revisions.
 759     system "make regen_headers </dev/null"
 760         and die;
 761 }
 762
 763 patch_C();
 764 patch_ext();
 765
 766 # Parallel build for miniperl is safe
 767 system "make $j miniperl </dev/null";
 768
 769 my $expected = $target =~ /^test/ ? 't/perl'
 770     : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}"
 771     : $target;
 772 my $real_target = $target eq 'Fcntl' ? $expected : $target;
 773
 774 if ($target ne 'miniperl') {
 775     # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
 776     $j = '' if $major < 10;
 777
 778     if ($real_target eq 'test_prep') {
 779         if ($major < 8) {
 780             # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
 781             # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
 782             # earlier than that, just make test. It will be fast enough.
 783             $real_target = extract_from_file('Makefile.SH',
 784                                              qr/^(test[-_]prep):/,
 785                                              'test');
 786         }
 787     }
 788
 789     system "make $j $real_target </dev/null";
 790 }
 791
 792 my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;
 793
 794 if ($options{'test-build'}) {
 795     report_and_exit($missing_target, 'could build', 'could not build',
 796                     $real_target);
 797 } elsif ($missing_target) {
 798     skip("could not build $real_target");
 799 }
 800
 801 match_and_exit($real_target) if $match;
 802
 803 if (defined $options{'one-liner'}) {
 804     my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl';
 805     unshift @ARGV, '-e', $options{'one-liner'};
 806     unshift @ARGV, '-l' if $options{l};
 807     unshift @ARGV, '-w' if $options{w};
 808     unshift @ARGV, "./$exe", '-Ilib';
 809 }
 810
 811 # This is what we came here to run:
 812
 813 if (exists $Config{ldlibpthname}) {
 814     require Cwd;
 815     my $varname = $Config{ldlibpthname};
 816     my $cwd = Cwd::getcwd();
 817     if (defined $ENV{$varname}) {
 818         $ENV{$varname} = $cwd . $Config{path_sep} . $ENV{$varname};
 819     } else {
 820         $ENV{$varname} = $cwd;
 821     }
 822 }
 823
 824 my $ret = system @ARGV;
 825
 826 report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
 827
 828 ############################################################################
 829 #
 830 # Patching, editing and faking routines only below here.
 831 #
 832 ############################################################################
 833
 834 sub fake_noextensions {
 835     edit_file('config.sh', sub {
 836                   my @lines = split /\n/, shift;
 837                   my @ext = split /\s+/, $defines{noextensions};
 838                   foreach (@lines) {
 839                       next unless /^extensions=/ || /^dynamic_ext/;
 840                       foreach my $ext (@ext) {
 841                           s/\b$ext( )?\b/$1/;
 842                       }
 843                   }
 844                   return join "\n", @lines;
 845               });
 846 }
 847
 848 sub force_manifest {
 849     my (@missing, @created_dirs);
 850     my $fh = open_or_die('MANIFEST');
 851     while (<$fh>) {
 852         next unless /^(\S+)/;
 853         # -d is special case needed (at least) between 27332437a2ed1941 and
 854         # bf3d9ec563d25054^ inclusive, as manifest contains ext/Thread/Thread
 855         push @missing, $1
 856             unless -f $1 || -d $1;
 857     }
 858     close_or_die($fh);
 859
 860     foreach my $pathname (@missing) {
 861         my @parts = split '/', $pathname;
 862         my $leaf = pop @parts;
 863         my $path = '.';
 864         while (@parts) {
 865             $path .= '/' . shift @parts;
 866             next if -d $path;
 867             mkdir $path, 0700 or die "Can't create $path: $!";
 868             unshift @created_dirs, $path;
 869         }
 870         $fh = open_or_die($pathname, '>');
 871         close_or_die($fh);
 872         chmod 0, $pathname or die "Can't chmod 0 $pathname: $!";
 873     }
 874     return \@missing, \@created_dirs;
 875 }
 876
 877 sub force_manifest_cleanup {
 878     my ($missing, $created_dirs) = @_;
 879     # This is probably way too paranoid:
 880     my @errors;
 881     require Fcntl;
 882     foreach my $file (@$missing) {
 883         my (undef, undef, $mode, undef, undef, undef, undef, $size)
 884             = stat $file;
 885         if (!defined $mode) {
 886             push @errors, "Added file $file has been deleted by Configure";
 887             next;
 888         }
 889         if (Fcntl::S_IMODE($mode) != 0) {
 890             push @errors,
 891                 sprintf 'Added file %s had mode changed by Configure to %03o',
 892                     $file, $mode;
 893         }
 894         if ($size != 0) {
 895             push @errors,
 896                 "Added file $file had sized changed by Configure to $size";
 897         }
 898         unlink $file or die "Can't unlink $file: $!";
 899     }
 900     foreach my $dir (@$created_dirs) {
 901         rmdir $dir or die "Can't rmdir $dir: $!";
 902     }
 903     skip("@errors")
 904         if @errors;
 905 }
 906
 907 sub patch_Configure {
 908     if ($major < 1) {
 909         if (extract_from_file('Configure',
 910                               qr/^\t\t\*=\*\) echo "\$1" >> \$optdef;;$/)) {
 911             # This is "        Spaces now allowed in -D command line options.",
 912             # part of commit ecfc54246c2a6f42
 913             apply_patch(<<'EOPATCH');
 914 diff --git a/Configure b/Configure
 915 index 3d3b38d..78ffe16 100755
 916 --- a/Configure
 917 +++ b/Configure
 918 @@ -652,7 +777,8 @@ while test $# -gt 0; do
 919                         echo "$me: use '-U symbol=', not '-D symbol='." >&2
 920                         echo "$me: ignoring -D $1" >&2
 921                         ;;
 922 -               *=*) echo "$1" >> $optdef;;
 923 +               *=*) echo "$1" | \
 924 +                               sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;;
 925                 *) echo "$1='define'" >> $optdef;;
 926                 esac
 927                 shift
 928 EOPATCH
 929         }
 930
 931         if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) {
 932             # Configure's original simple "grep" for d_namlen falls foul of the
 933             # approach taken by the glibc headers:
 934             # #ifdef _DIRENT_HAVE_D_NAMLEN
 935             # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen)
 936             #
 937             # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux.
 938             # This is also part of commit ecfc54246c2a6f42
 939             apply_patch(<<'EOPATCH');
 940 diff --git a/Configure b/Configure
 941 index 3d3b38d..78ffe16 100755
 942 --- a/Configure
 943 +++ b/Configure
 944 @@ -3935,7 +4045,8 @@ $rm -f try.c
 945
 946  : see if the directory entry stores field length
 947  echo " "
 948 -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
 949 +$cppstdin $cppflags $cppminus < "$xinc" > try.c
 950 +if $contains 'd_namlen' try.c >/dev/null 2>&1; then
 951         echo "Good, your directory entry keeps length information in d_namlen." >&4
 952         val="$define"
 953  else
 954 EOPATCH
 955         }
 956     }
 957
 958     if ($major < 2
 959         && !extract_from_file('Configure',
 960                               qr/Try to guess additional flags to pick up local libraries/)) {
 961         my $mips = extract_from_file('Configure',
 962                                      qr!(''\) if (?:\./)?mips; then)!);
 963         # This is part of perl-5.001n. It's needed, to add -L/usr/local/lib to
 964         # theld flags if libraries are found there. It shifts the code to set up
 965         # libpth earlier, and then adds the code to add libpth entries to
 966         # ldflags
 967         # mips was changed to ./mips in ecfc54246c2a6f42, perl5.000 patch.0g
 968         apply_patch(sprintf <<'EOPATCH', $mips);
 969 diff --git a/Configure b/Configure
 970 index 53649d5..0635a6e 100755
 971 --- a/Configure
 972 +++ b/Configure
 973 @@ -2749,6 +2749,52 @@ EOM
 974         ;;
 975  esac
 976
 977 +: Set private lib path
 978 +case "$plibpth" in
 979 +'') if ./mips; then
 980 +               plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
 981 +       fi;;
 982 +esac
 983 +case "$libpth" in
 984 +' ') dlist='';;
 985 +'') dlist="$plibpth $glibpth";;
 986 +*) dlist="$libpth";;
 987 +esac
 988 +
 989 +: Now check and see which directories actually exist, avoiding duplicates
 990 +libpth=''
 991 +for xxx in $dlist
 992 +do
 993 +    if $test -d $xxx; then
 994 +               case " $libpth " in
 995 +               *" $xxx "*) ;;
 996 +               *) libpth="$libpth $xxx";;
 997 +               esac
 998 +    fi
 999 +done
1000 +$cat <<'EOM'
1001 +
1002 +Some systems have incompatible or broken versions of libraries.  Among
1003 +the directories listed in the question below, please remove any you
1004 +know not to be holding relevant libraries, and add any that are needed.
1005 +Say "none" for none.
1006 +
1007 +EOM
1008 +case "$libpth" in
1009 +'') dflt='none';;
1010 +*)
1011 +       set X $libpth
1012 +       shift
1013 +       dflt=${1+"$@"}
1014 +       ;;
1015 +esac
1016 +rp="Directories to use for library searches?"
1017 +. ./myread
1018 +case "$ans" in
1019 +none) libpth=' ';;
1020 +*) libpth="$ans";;
1021 +esac
1022 +
1023  : flags used in final linking phase
1024  case "$ldflags" in
1025  '') if ./venix; then
1026 @@ -2765,6 +2811,23 @@ case "$ldflags" in
1027         ;;
1028  *) dflt="$ldflags";;
1029  esac
1030 +
1031 +: Possible local library directories to search.
1032 +loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib"
1033 +loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib"
1034 +
1035 +: Try to guess additional flags to pick up local libraries.
1036 +for thislibdir in $libpth; do
1037 +       case " $loclibpth " in
1038 +       *" $thislibdir "*)
1039 +               case "$dflt " in
1040 +               "-L$thislibdir ") ;;
1041 +               *)  dflt="$dflt -L$thislibdir" ;;
1042 +               esac
1043 +               ;;
1044 +       esac
1045 +done
1046 +
1047  echo " "
1048  rp="Any additional ld flags (NOT including libraries)?"
1049  . ./myread
1050 @@ -2828,52 +2891,6 @@ n) echo "OK, that should do.";;
1051  esac
1052  $rm -f try try.* core
1053
1054 -: Set private lib path
1055 -case "$plibpth" in
1056 -%s
1057 -               plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
1058 -       fi;;
1059 -esac
1060 -case "$libpth" in
1061 -' ') dlist='';;
1062 -'') dlist="$plibpth $glibpth";;
1063 -*) dlist="$libpth";;
1064 -esac
1065 -
1066 -: Now check and see which directories actually exist, avoiding duplicates
1067 -libpth=''
1068 -for xxx in $dlist
1069 -do
1070 -    if $test -d $xxx; then
1071 -               case " $libpth " in
1072 -               *" $xxx "*) ;;
1073 -               *) libpth="$libpth $xxx";;
1074 -               esac
1075 -    fi
1076 -done
1077 -$cat <<'EOM'
1078 -
1079 -Some systems have incompatible or broken versions of libraries.  Among
1080 -the directories listed in the question below, please remove any you
1081 -know not to be holding relevant libraries, and add any that are needed.
1082 -Say "none" for none.
1083 -
1084 -EOM
1085 -case "$libpth" in
1086 -'') dflt='none';;
1087 -*)
1088 -       set X $libpth
1089 -       shift
1090 -       dflt=${1+"$@"}
1091 -       ;;
1092 -esac
1093 -rp="Directories to use for library searches?"
1094 -. ./myread
1095 -case "$ans" in
1096 -none) libpth=' ';;
1097 -*) libpth="$ans";;
1098 -esac
1099 -
1100  : compute shared library extension
1101  case "$so" in
1102  '')
1103 EOPATCH
1104     }
1105
1106     if ($major < 5 && extract_from_file('Configure',
1107                                         qr!if \$cc \$ccflags try\.c -o try >/dev/null 2>&1; then!)) {
1108         # Analogous to the more general fix of dfe9444ca7881e71
1109         # Without this flags such as -m64 may not be passed to this compile,
1110         # which results in a byteorder of '1234' instead of '12345678', which
1111         # can then cause crashes.
1112
1113         if (extract_from_file('Configure', qr/xxx_prompt=y/)) {
1114             # 8e07c86ebc651fe9 or later
1115             # ("This is my patch  patch.1n  for perl5.001.")
1116             apply_patch(<<'EOPATCH');
1117 diff --git a/Configure b/Configure
1118 index 62249dd..c5c384e 100755
1119 --- a/Configure
1120 +++ b/Configure
1121 @@ -8247,7 +8247,7 @@ main()
1122  }
1123  EOCP
1124         xxx_prompt=y
1125 -       if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
1126 +       if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
1127                 dflt=`./try`
1128                 case "$dflt" in
1129                 [1-4][1-4][1-4][1-4]|12345678|87654321)
1130 EOPATCH
1131         } else {
1132             apply_patch(<<'EOPATCH');
1133 diff --git a/Configure b/Configure
1134 index 53649d5..f1cd64a 100755
1135 --- a/Configure
1136 +++ b/Configure
1137 @@ -6362,7 +6362,7 @@ main()
1138         printf("\n");
1139  }
1140  EOCP
1141 -       if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then
1142 +       if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 ; then
1143                 dflt=`./try`
1144                 case "$dflt" in
1145                 ????|????????) echo "(The test program ran ok.)";;
1146 EOPATCH
1147         }
1148     }
1149
1150     if ($major < 6 && !extract_from_file('Configure',
1151                                          qr!^\t-A\)$!)) {
1152         # This adds the -A option to Configure, which is incredibly useful
1153         # Effectively this is commits 02e93a22d20fc9a5, 5f83a3e9d818c3ad,
1154         # bde6b06b2c493fef, f7c3111703e46e0c and 2 lines of trailing whitespace
1155         # removed by 613d6c3e99b9decc, but applied at slightly different
1156         # locations to ensure a clean patch back to 5.000
1157         # Note, if considering patching to the intermediate revisions to fix
1158         # bugs in -A handling, f7c3111703e46e0c is from 2002, and hence
1159         # $major == 8
1160
1161         # To add to the fun, early patches add -K and -O options, and it's not
1162         # trivial to get patch to put the C<. ./posthint.sh> in the right place
1163         edit_file('Configure', sub {
1164                       my $code = shift;
1165                       $code =~ s/(optstr = ")([^"]+";\s*# getopt-style specification)/$1A:$2/
1166                           or die "Substitution failed";
1167                       $code =~ s!^(: who configured the system)!
1168 touch posthint.sh
1169 . ./posthint.sh
1170
1171 $1!ms
1172                           or die "Substitution failed";
1173                       return $code;
1174                   });
1175         apply_patch(<<'EOPATCH');
1176 diff --git a/Configure b/Configure
1177 index 4b55fa6..60c3c64 100755
1178 --- a/Configure
1179 +++ b/Configure
1180 @@ -1150,6 +1150,7 @@ set X `for arg in "$@"; do echo "X$arg"; done |
1181  eval "set $*"
1182  shift
1183  rm -f options.awk
1184 +rm -f posthint.sh
1185
1186  : set up default values
1187  fastread=''
1188 @@ -1172,6 +1173,56 @@ while test $# -gt 0; do
1189         case "$1" in
1190         -d) shift; fastread=yes;;
1191         -e) shift; alldone=cont;;
1192 +       -A)
1193 +           shift
1194 +           xxx=''
1195 +           yyy="$1"
1196 +           zzz=''
1197 +           uuu=undef
1198 +           case "$yyy" in
1199 +            *=*) zzz=`echo "$yyy"|sed 's!=.*!!'`
1200 +                 case "$zzz" in
1201 +                 *:*) zzz='' ;;
1202 +                 *)   xxx=append
1203 +                      zzz=" "`echo "$yyy"|sed 's!^[^=]*=!!'`
1204 +                      yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
1205 +                 esac
1206 +                 ;;
1207 +            esac
1208 +            case "$xxx" in
1209 +            '')  case "$yyy" in
1210 +                 *:*) xxx=`echo "$yyy"|sed 's!:.*!!'`
1211 +                      yyy=`echo "$yyy"|sed 's!^[^:]*:!!'`
1212 +                      zzz=`echo "$yyy"|sed 's!^[^=]*=!!'`
1213 +                      yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
1214 +                 *)   xxx=`echo "$yyy"|sed 's!:.*!!'`
1215 +                      yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` ;;
1216 +                 esac
1217 +                 ;;
1218 +            esac
1219 +           case "$xxx" in
1220 +           append)
1221 +               echo "$yyy=\"\${$yyy}$zzz\""    >> posthint.sh ;;
1222 +           clear)
1223 +               echo "$yyy=''"                  >> posthint.sh ;;
1224 +           define)
1225 +               case "$zzz" in
1226 +               '') zzz=define ;;
1227 +               esac
1228 +               echo "$yyy='$zzz'"              >> posthint.sh ;;
1229 +           eval)
1230 +               echo "eval \"$yyy=$zzz\""       >> posthint.sh ;;
1231 +           prepend)
1232 +               echo "$yyy=\"$zzz\${$yyy}\""    >> posthint.sh ;;
1233 +           undef)
1234 +               case "$zzz" in
1235 +               '') zzz="$uuu" ;;
1236 +               esac
1237 +               echo "$yyy=$zzz"                >> posthint.sh ;;
1238 +            *)  echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2 ;;
1239 +           esac
1240 +           shift
1241 +           ;;
1242         -f)
1243                 shift
1244                 cd ..
1245 EOPATCH
1246     }
1247
1248     if ($major < 8 && !extract_from_file('Configure',
1249                                          qr/^\t\tif test ! -t 0; then$/)) {
1250         # Before dfe9444ca7881e71, Configure would refuse to run if stdin was
1251         # not a tty. With that commit, the tty requirement was dropped for -de
1252         # and -dE
1253         # Commit aaeb8e512e8e9e14 dropped the tty requirement for -S
1254         # For those older versions, it's probably easiest if we simply remove
1255         # the sanity test.
1256         edit_file('Configure', sub {
1257                       my $code = shift;
1258                       $code =~ s/test ! -t 0/test Perl = rules/;
1259                       return $code;
1260                   });
1261     }
1262
1263     if ($major == 8 || $major == 9) {
1264         # Fix symbol detection to that of commit 373dfab3839ca168 if it's any
1265         # intermediate version 5129fff43c4fe08c or later, as the intermediate
1266         # versions don't work correctly on (at least) Sparc Linux.
1267         # 5129fff43c4fe08c adds the first mention of mistrustnm.
1268         # 373dfab3839ca168 removes the last mention of lc=""
1269         edit_file('Configure', sub {
1270                       my $code = shift;
1271                       return $code
1272                           if $code !~ /\btc="";/; # 373dfab3839ca168 or later
1273                       return $code
1274                           if $code !~ /\bmistrustnm\b/; # before 5129fff43c4fe08c
1275                       my $fixed = <<'EOC';
1276
1277 : is a C symbol defined?
1278 csym='tlook=$1;
1279 case "$3" in
1280 -v) tf=libc.tmp; tdc="";;
1281 -a) tf=libc.tmp; tdc="[]";;
1282 *) tlook="^$1\$"; tf=libc.list; tdc="()";;
1283 esac;
1284 tx=yes;
1285 case "$reuseval-$4" in
1286 true-) ;;
1287 true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;;
1288 esac;
1289 case "$tx" in
1290 yes)
1291         tval=false;
1292         if $test "$runnm" = true; then
1293                 if $contains $tlook $tf >/dev/null 2>&1; then
1294                         tval=true;
1295                 elif $test "$mistrustnm" = compile -o "$mistrustnm" = run; then
1296                         echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
1297                         $cc -o try $optimize $ccflags $ldflags try.c >/dev/null 2>&1 $libs && tval=true;
1298                         $test "$mistrustnm" = run -a -x try && { $run ./try$_exe >/dev/null 2>&1 || tval=false; };
1299                         $rm -f try$_exe try.c core core.* try.core;
1300                 fi;
1301         else
1302                 echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
1303                 $cc -o try $optimize $ccflags $ldflags try.c $libs >/dev/null 2>&1 && tval=true;
1304                 $rm -f try$_exe try.c;
1305         fi;
1306         ;;
1307 *)
1308         case "$tval" in
1309         $define) tval=true;;
1310         *) tval=false;;
1311         esac;
1312         ;;
1313 esac;
1314 eval "$2=$tval"'
1315
1316 EOC
1317                       $code =~ s/\n: is a C symbol defined\?\n.*?\neval "\$2=\$tval"'\n\n/$fixed/sm
1318                           or die "substitution failed";
1319                       return $code;
1320                   });
1321     }
1322
1323     if ($major < 10
1324         && extract_from_file('Configure', qr/^set malloc\.h i_malloc$/)) {
1325         # This is commit 01d07975f7ef0e7d, trimmed, with $compile inlined as
1326         # prior to bd9b35c97ad661cc Configure had the malloc.h test before the
1327         # definition of $compile.
1328         apply_patch(<<'EOPATCH');
1329 diff --git a/Configure b/Configure
1330 index 3d2e8b9..6ce7766 100755
1331 --- a/Configure
1332 +++ b/Configure
1333 @@ -6743,5 +6743,22 @@ set d_dosuid
1334
1335  : see if this is a malloc.h system
1336 -set malloc.h i_malloc
1337 -eval $inhdr
1338 +: we want a real compile instead of Inhdr because some systems have a
1339 +: malloc.h that just gives a compile error saying to use stdlib.h instead
1340 +echo " "
1341 +$cat >try.c <<EOCP
1342 +#include <stdlib.h>
1343 +#include <malloc.h>
1344 +int main () { return 0; }
1345 +EOCP
1346 +set try
1347 +if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then
1348 +    echo "<malloc.h> found." >&4
1349 +    val="$define"
1350 +else
1351 +    echo "<malloc.h> NOT found." >&4
1352 +    val="$undef"
1353 +fi
1354 +$rm -f try.c try
1355 +set i_malloc
1356 +eval $setvar
1357
1358 EOPATCH
1359     }
1360 }
1361
1362 sub patch_hints {
1363     if ($^O eq 'freebsd') {
1364         # There are rather too many version-specific FreeBSD hints fixes to
1365         # patch individually. Also, more than once the FreeBSD hints file has
1366         # been written in what turned out to be a rather non-future-proof style,
1367         # with case statements treating the most recent version as the
1368         # exception, instead of treating previous versions' behaviour explicitly
1369         # and changing the default to cater for the current behaviour. (As
1370         # strangely, future versions inherit the current behaviour.)
1371         checkout_file('hints/freebsd.sh');
1372     } elsif ($^O eq 'darwin') {
1373         if ($major < 8) {
1374             # We can't build on darwin without some of the data in the hints
1375             # file. Probably less surprising to use the earliest version of
1376             # hints/darwin.sh and then edit in place just below, than use
1377             # blead's version, as that would create a discontinuity at
1378             # f556e5b971932902 - before it, hints bugs would be "fixed", after
1379             # it they'd resurface. This way, we should give the illusion of
1380             # monotonic bug fixing.
1381             my $faking_it;
1382             if (!-f 'hints/darwin.sh') {
1383                 checkout_file('hints/darwin.sh', 'f556e5b971932902');
1384                 ++$faking_it;
1385             }
1386
1387             edit_file('hints/darwin.sh', sub {
1388                       my $code = shift;
1389                       # Part of commit 8f4f83badb7d1ba9, which mostly undoes
1390                       # commit 0511a818910f476c.
1391                       $code =~ s/^cppflags='-traditional-cpp';$/cppflags="\${cppflags} -no-cpp-precomp"/m;
1392                       # commit 14c11978e9b52e08/803bb6cc74d36a3f
1393                       # Without this, code in libperl.bundle links against op.o
1394                       # in preference to opmini.o on the linker command line,
1395                       # and hence miniperl tries to use File::Glob instead of
1396                       # csh
1397                       $code =~ s/^(lddlflags=)/ldflags="\${ldflags} -flat_namespace"\n$1/m;
1398                       # f556e5b971932902 also patches Makefile.SH with some
1399                       # special case code to deal with useshrplib for darwin.
1400                       # Given that post 5.8.0 the darwin hints default was
1401                       # changed to false, and it would be very complex to splice
1402                       # in that code in various versions of Makefile.SH back
1403                       # to 5.002, lets just turn it off.
1404                       $code =~ s/^useshrplib='true'/useshrplib='false'/m
1405                           if $faking_it;
1406                       return $code;
1407                   });
1408         }
1409     } elsif ($^O eq 'netbsd') {
1410         if ($major < 6) {
1411             # These are part of commit 099685bc64c7dbce
1412             edit_file('hints/netbsd.sh', sub {
1413                           my $code = shift;
1414                           my $fixed = <<'EOC';
1415 case "$osvers" in
1416 0.9|0.8*)
1417         usedl="$undef"
1418         ;;
1419 *)
1420         if [ -f /usr/libexec/ld.elf_so ]; then
1421                 d_dlopen=$define
1422                 d_dlerror=$define
1423                 ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags"
1424                 cccdlflags="-DPIC -fPIC $cccdlflags"
1425                 lddlflags="--whole-archive -shared $lddlflags"
1426         elif [ "`uname -m`" = "pmax" ]; then
1427 # NetBSD 1.3 and 1.3.1 on pmax shipped an `old' ld.so, which will not work.
1428                 d_dlopen=$undef
1429         elif [ -f /usr/libexec/ld.so ]; then
1430                 d_dlopen=$define
1431                 d_dlerror=$define
1432                 ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags"
1433 # we use -fPIC here because -fpic is *NOT* enough for some of the
1434 # extensions like Tk on some netbsd platforms (the sparc is one)
1435                 cccdlflags="-DPIC -fPIC $cccdlflags"
1436                 lddlflags="-Bforcearchive -Bshareable $lddlflags"
1437         else
1438                 d_dlopen=$undef
1439         fi
1440         ;;
1441 esac
1442 EOC
1443                           $code =~ s/^case "\$osvers" in\n0\.9\|0\.8.*?^esac\n/$fixed/ms;
1444                           return $code;
1445                       });
1446         }
1447     } elsif ($^O eq 'openbsd') {
1448         if ($major < 8) {
1449             checkout_file('hints/openbsd.sh', '43051805d53a3e4c')
1450                 unless -f 'hints/openbsd.sh';
1451             my $which = extract_from_file('hints/openbsd.sh',
1452                                           qr/# from (2\.8|3\.1) onwards/,
1453                                           '');
1454             if ($which eq '') {
1455                 my $was = extract_from_file('hints/openbsd.sh',
1456                                             qr/(lddlflags="(?:-Bforcearchive )?-Bshareable)/);
1457                 # This is commit 154d43cbcf57271c and parts of 5c75dbfa77b0949c
1458                 # and 29b5585702e5e025
1459                 apply_patch(sprintf <<'EOPATCH', $was);
1460 diff --git a/hints/openbsd.sh b/hints/openbsd.sh
1461 index a7d8bf2..5b79709 100644
1462 --- a/hints/openbsd.sh
1463 +++ b/hints/openbsd.sh
1464 @@ -37,7 +37,25 @@ OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax)
1465         # we use -fPIC here because -fpic is *NOT* enough for some of the
1466         # extensions like Tk on some OpenBSD platforms (ie: sparc)
1467         cccdlflags="-DPIC -fPIC $cccdlflags"
1468 -       %s $lddlflags"
1469 +       case "$osvers" in
1470 +       [01].*|2.[0-7]|2.[0-7].*)
1471 +               lddlflags="-Bshareable $lddlflags"
1472 +               ;;
1473 +       2.[8-9]|3.0)
1474 +               ld=${cc:-cc}
1475 +               lddlflags="-shared -fPIC $lddlflags"
1476 +               ;;
1477 +       *) # from 3.1 onwards
1478 +               ld=${cc:-cc}
1479 +               lddlflags="-shared -fPIC $lddlflags"
1480 +               libswanted=`echo $libswanted | sed 's/ dl / /'`
1481 +               ;;
1482 +       esac
1483 +
1484 +       # We need to force ld to export symbols on ELF platforms.
1485 +       # Without this, dlopen() is crippled.
1486 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
1487 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
1488         ;;
1489  esac
1490
1491 EOPATCH
1492             } elsif ($which eq '2.8') {
1493                 # This is parts of 5c75dbfa77b0949c and 29b5585702e5e025, and
1494                 # possibly eb9cd59d45ad2908
1495                 my $was = extract_from_file('hints/openbsd.sh',
1496                                             qr/lddlflags="(-shared(?: -fPIC)?) \$lddlflags"/);
1497
1498                 apply_patch(sprintf <<'EOPATCH', $was);
1499 --- a/hints/openbsd.sh  2011-10-21 17:25:20.000000000 +0200
1500 +++ b/hints/openbsd.sh  2011-10-21 16:58:43.000000000 +0200
1501 @@ -44,11 +44,21 @@
1502         [01].*|2.[0-7]|2.[0-7].*)
1503                 lddlflags="-Bshareable $lddlflags"
1504                 ;;
1505 -       *) # from 2.8 onwards
1506 +       2.[8-9]|3.0)
1507                 ld=${cc:-cc}
1508 -               lddlflags="%s $lddlflags"
1509 +               lddlflags="-shared -fPIC $lddlflags"
1510 +               ;;
1511 +       *) # from 3.1 onwards
1512 +               ld=${cc:-cc}
1513 +               lddlflags="-shared -fPIC $lddlflags"
1514 +               libswanted=`echo $libswanted | sed 's/ dl / /'`
1515                 ;;
1516         esac
1517 +
1518 +       # We need to force ld to export symbols on ELF platforms.
1519 +       # Without this, dlopen() is crippled.
1520 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
1521 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
1522         ;;
1523  esac
1524
1525 EOPATCH
1526             } elsif ($which eq '3.1'
1527                      && !extract_from_file('hints/openbsd.sh',
1528                                            qr/We need to force ld to export symbols on ELF platforms/)) {
1529                 # This is part of 29b5585702e5e025
1530                 apply_patch(<<'EOPATCH');
1531 diff --git a/hints/openbsd.sh b/hints/openbsd.sh
1532 index c6b6bc9..4839d04 100644
1533 --- a/hints/openbsd.sh
1534 +++ b/hints/openbsd.sh
1535 @@ -54,6 +54,11 @@ alpha-2.[0-8]|mips-*|vax-*|powerpc-2.[0-7]|m88k-*)
1536                 libswanted=`echo $libswanted | sed 's/ dl / /'`
1537                 ;;
1538         esac
1539 +
1540 +       # We need to force ld to export symbols on ELF platforms.
1541 +       # Without this, dlopen() is crippled.
1542 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
1543 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
1544         ;;
1545  esac
1546
1547 EOPATCH
1548             }
1549         }
1550     } elsif ($^O eq 'linux') {
1551         if ($major < 1) {
1552             # sparc linux seems to need the -Dbool=char -DHAS_BOOL part of
1553             # perl5.000 patch.0n: [address Configure and build issues]
1554             edit_file('hints/linux.sh', sub {
1555                           my $code = shift;
1556                           $code =~ s!-I/usr/include/bsd!-Dbool=char -DHAS_BOOL!g;
1557                           return $code;
1558                       });
1559         }
1560
1561         if ($major <= 9) {
1562             if (`uname -sm` =~ qr/^Linux sparc/) {
1563                 if (extract_from_file('hints/linux.sh', qr/sparc-linux/)) {
1564                     # Be sure to use -fPIC not -fpic on Linux/SPARC
1565                     apply_commit('f6527d0ef0c13ad4');
1566                 } elsif(!extract_from_file('hints/linux.sh',
1567                                            qr/^sparc-linux\)$/)) {
1568                     my $fh = open_or_die('hints/linux.sh', '>>');
1569                     print $fh <<'EOT' or die $!;
1570
1571 case "`uname -m`" in
1572 sparc*)
1573         case "$cccdlflags" in
1574         *-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;;
1575         *)       cccdlflags="$cccdlflags -fPIC" ;;
1576         esac
1577         ;;
1578 esac
1579 EOT
1580                     close_or_die($fh);
1581                 }
1582             }
1583         }
1584     }
1585 }
1586
1587 sub patch_SH {
1588     # Cwd.xs added in commit 0d2079faa739aaa9. Cwd.pm moved to ext/ 8 years
1589     # later in commit 403f501d5b37ebf0
1590     if ($major > 0 && <*/Cwd/Cwd.xs>) {
1591         if ($major < 10
1592             && !extract_from_file('Makefile.SH', qr/^extra_dep=''$/)) {
1593             # The Makefile.PL for Unicode::Normalize needs
1594             # lib/unicore/CombiningClass.pl. Even without a parallel build, we
1595             # need a dependency to ensure that it builds. This is a variant of
1596             # commit 9f3ef600c170f61e. Putting this for earlier versions gives
1597             # us a spot on which to hang the edits below
1598             apply_patch(<<'EOPATCH');
1599 diff --git a/Makefile.SH b/Makefile.SH
1600 index f61d0db..6097954 100644
1601 --- a/Makefile.SH
1602 +++ b/Makefile.SH
1603 @@ -155,10 +155,20 @@ esac
1604
1605  : Prepare dependency lists for Makefile.
1606  dynamic_list=' '
1607 +extra_dep=''
1608  for f in $dynamic_ext; do
1609      : the dependency named here will never exist
1610        base=`echo "$f" | sed 's/.*\///'`
1611 -    dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext"
1612 +    this_target="lib/auto/$f/$base.$dlext"
1613 +    dynamic_list="$dynamic_list $this_target"
1614 +
1615 +    : Parallel makes reveal that we have some interdependencies
1616 +    case $f in
1617 +       Math/BigInt/FastCalc) extra_dep="$extra_dep
1618 +$this_target: lib/auto/List/Util/Util.$dlext" ;;
1619 +       Unicode/Normalize) extra_dep="$extra_dep
1620 +$this_target: lib/unicore/CombiningClass.pl" ;;
1621 +    esac
1622  done
1623
1624  static_list=' '
1625 @@ -987,2 +997,9 @@ n_dummy $(nonxs_ext):       miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE
1626         @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
1627 +!NO!SUBS!
1628 +
1629 +$spitshell >>Makefile <<EOF
1630 +$extra_dep
1631 +EOF
1632 +
1633 +$spitshell >>Makefile <<'!NO!SUBS!'
1634
1635 EOPATCH
1636         }
1637
1638         if ($major == 11) {
1639             if (extract_from_file('patchlevel.h',
1640                                   qr/^#include "unpushed\.h"/)) {
1641                 # I had thought it easier to detect when building one of the 52
1642                 # commits with the original method of incorporating the git
1643                 # revision and drop parallel make flags. Commits shown by
1644                 # git log 46807d8e809cc127^..dcff826f70bf3f64^ ^d4fb0a1f15d1a1c4
1645                 # However, it's not actually possible to make miniperl for that
1646                 # configuration as-is, because the file .patchnum is only made
1647                 # as a side effect of target 'all'
1648                 # I also don't think that it's "safe" to simply run
1649                 # make_patchnum.sh before the build. We need the proper
1650                 # dependency rules in the Makefile to *stop* it being run again
1651                 # at the wrong time.
1652                 # This range is important because contains the commit that
1653                 # merges Schwern's y2038 work.
1654                 apply_patch(<<'EOPATCH');
1655 diff --git a/Makefile.SH b/Makefile.SH
1656 index 9ad8b6f..106e721 100644
1657 --- a/Makefile.SH
1658 +++ b/Makefile.SH
1659 @@ -540,9 +544,14 @@ sperl.i: perl.c $(h)
1660
1661  .PHONY: all translators utilities make_patchnum
1662
1663 -make_patchnum:
1664 +make_patchnum: lib/Config_git.pl
1665 +
1666 +lib/Config_git.pl: make_patchnum.sh
1667         sh $(shellflags) make_patchnum.sh
1668
1669 +# .patchnum, unpushed.h and lib/Config_git.pl are built by make_patchnum.sh
1670 +unpushed.h .patchnum: lib/Config_git.pl
1671 +
1672  # make sure that we recompile perl.c if .patchnum changes
1673  perl$(OBJ_EXT): .patchnum unpushed.h
1674
1675 EOPATCH
1676             } elsif (-f '.gitignore'
1677                      && extract_from_file('.gitignore', qr/^\.patchnum$/)) {
1678                 # 8565263ab8a47cda to 46807d8e809cc127^ inclusive.
1679                 edit_file('Makefile.SH', sub {
1680                               my $code = shift;
1681                               $code =~ s/^make_patchnum:\n/make_patchnum: .patchnum
1682
1683 .sha1: .patchnum
1684
1685 .patchnum: make_patchnum.sh
1686 /m;
1687                               return $code;
1688                           });
1689             } elsif (-f 'lib/.gitignore'
1690                      && extract_from_file('lib/.gitignore',
1691                                           qr!^/Config_git.pl!)
1692                      && !extract_from_file('Makefile.SH',
1693                                         qr/^uudmap\.h.*:bitcount.h$/)) {
1694                 # Between commits and dcff826f70bf3f64 and 0f13ebd5d71f8177^
1695                 edit_file('Makefile.SH', sub {
1696                               my $code = shift;
1697                               # Bug introduced by 344af494c35a9f0f
1698                               # fixed in 0f13ebd5d71f8177
1699                               $code =~ s{^(pod/perlapi\.pod) (pod/perlintern\.pod): }
1700                                         {$1: $2\n\n$2: }m;
1701                               # Bug introduced by efa50c51e3301a2c
1702                               # fixed in 0f13ebd5d71f8177
1703                               $code =~ s{^(uudmap\.h) (bitcount\.h): }
1704                                         {$1: $2\n\n$2: }m;
1705
1706                               # The rats nest of getting git_version.h correct
1707
1708                               if ($code =~ s{git_version\.h: stock_git_version\.h
1709 \tcp stock_git_version\.h git_version\.h}
1710                                             {}m) {
1711                                   # before 486cd780047ff224
1712
1713                                   # We probably can't build between
1714                                   # 953f6acfa20ec275^ and 8565263ab8a47cda
1715                                   # inclusive, but all commits in that range
1716                                   # relate to getting make_patchnum.sh working,
1717                                   # so it is extremely unlikely to be an
1718                                   # interesting bisect target. They will skip.
1719
1720                                   # No, don't spawn a submake if
1721                                   # make_patchnum.sh or make_patchnum.pl fails
1722                                   $code =~ s{\|\| \$\(MAKE\) miniperl.*}
1723                                             {}m;
1724                                   $code =~ s{^\t(sh.*make_patchnum\.sh.*)}
1725                                             {\t-$1}m;
1726
1727                                   # Use an external perl to run make_patchnum.pl
1728                                   # because miniperl still depends on
1729                                   # git_version.h
1730                                   $code =~ s{^\t.*make_patchnum\.pl}
1731                                             {\t-$^X make_patchnum.pl}m;
1732
1733
1734                                   # "Truth in advertising" - running
1735                                   # make_patchnum generates 2 files.
1736                                   $code =~ s{^make_patchnum:.*}{
1737 make_patchnum: lib/Config_git.pl
1738
1739 git_version.h: lib/Config_git.pl
1740
1741 perlmini\$(OBJ_EXT): git_version.h
1742
1743 lib/Config_git.pl:}m;
1744                               }
1745                               return $code;
1746                           });
1747             }
1748         }
1749
1750         if ($major < 14) {
1751             # Commits dc0655f797469c47 and d11a62fe01f2ecb2
1752             edit_file('Makefile.SH', sub {
1753                           my $code = shift;
1754                           foreach my $ext (qw(Encode SDBM_File)) {
1755                               next if $code =~ /\b$ext\) extra_dep=/s;
1756                               $code =~ s!(\) extra_dep="\$extra_dep
1757 \$this_target: .*?" ;;)
1758 (    esac
1759 )!$1
1760         $ext) extra_dep="\$extra_dep
1761 \$this_target: lib/auto/Cwd/Cwd.\$dlext" ;;
1762 $2!;
1763                           }
1764                           return $code;
1765                       });
1766         }
1767     }
1768
1769     if ($major == 7) {
1770         # Remove commits 9fec149bb652b6e9 and 5bab1179608f81d8, which add/amend
1771         # rules to automatically run regen scripts that rebuild C headers. These
1772         # cause problems because a git checkout doesn't preserve relative file
1773         # modification times, hence the regen scripts may fire. This will
1774         # obscure whether the repository had the correct generated headers
1775         # checked in.
1776         # Also, the dependency rules for running the scripts were not correct,
1777         # which could cause spurious re-builds on re-running make, and can cause
1778         # complete build failures for a parallel make.
1779         if (extract_from_file('Makefile.SH',
1780                               qr/Writing it this way gives make a big hint to always run opcode\.pl before/)) {
1781             apply_commit('70c6e6715e8fec53');
1782         } elsif (extract_from_file('Makefile.SH',
1783                                    qr/^opcode\.h opnames\.h pp_proto\.h pp\.sym: opcode\.pl$/)) {
1784             revert_commit('9fec149bb652b6e9');
1785         }
1786     }
1787
1788     # There was a bug in makedepend.SH which was fixed in version 96a8704c.
1789     # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
1790     # Remove this if you're actually bisecting a problem related to
1791     # makedepend.SH
1792     # If you do this, you may need to add in code to correct the output of older
1793     # makedepends, which don't correctly filter newer gcc output such as
1794     # <built-in>
1795     checkout_file('makedepend.SH');
1796
1797     if ($major < 4 && -f 'config.sh'
1798         && !extract_from_file('config.sh', qr/^trnl=/)) {
1799         # This seems to be necessary to avoid makedepend becoming confused,
1800         # and hanging on stdin. Seems that the code after
1801         # make shlist || ...here... is never run.
1802         edit_file('makedepend.SH', sub {
1803                       my $code = shift;
1804                       $code =~ s/^trnl='\$trnl'$/trnl='\\n'/m;
1805                       return $code;
1806                   });
1807     }
1808 }
1809
1810 sub patch_C {
1811     # This is ordered by $major, as it's likely that different platforms may
1812     # well want to share code.
1813
1814     if ($major == 2 && extract_from_file('perl.c', qr/^\tfclose\(e_fp\);$/)) {
1815         # need to patch perl.c to avoid calling fclose() twice on e_fp when
1816         # using -e
1817         # This diff is part of commit ab821d7fdc14a438. The second close was
1818         # introduced with perl-5.002, commit a5f75d667838e8e7
1819         # Might want a6c477ed8d4864e6 too, for the corresponding change to
1820         # pp_ctl.c (likely without this, eval will have "fun")
1821         apply_patch(<<'EOPATCH');
1822 diff --git a/perl.c b/perl.c
1823 index 03c4d48..3c814a2 100644
1824 --- a/perl.c
1825 +++ b/perl.c
1826 @@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
1827  #ifndef VMS  /* VMS doesn't have environ array */
1828      origenviron = environ;
1829  #endif
1830 +    e_tmpname = Nullch;
1831
1832      if (do_undump) {
1833
1834 @@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
1835      if (e_fp) {
1836         if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
1837             croak("Can't write to temp file for -e: %s", Strerror(errno));
1838 +       e_fp = Nullfp;
1839         argc++,argv--;
1840         scriptname = e_tmpname;
1841      }
1842 @@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
1843      curcop->cop_line = 0;
1844      curstash = defstash;
1845      preprocess = FALSE;
1846 -    if (e_fp) {
1847 -       fclose(e_fp);
1848 -       e_fp = Nullfp;
1849 +    if (e_tmpname) {
1850         (void)UNLINK(e_tmpname);
1851 +       Safefree(e_tmpname);
1852 +       e_tmpname = Nullch;
1853      }
1854
1855      /* now that script is parsed, we can modify record separator */
1856 @@ -1369,7 +1371,7 @@ SV *sv;
1857         scriptname = xfound;
1858      }
1859
1860 -    origfilename = savepv(e_fp ? "-e" : scriptname);
1861 +    origfilename = savepv(e_tmpname ? "-e" : scriptname);
1862      curcop->cop_filegv = gv_fetchfile(origfilename);
1863      if (strEQ(origfilename,"-"))
1864         scriptname = "";
1865
1866 EOPATCH
1867     }
1868
1869     if ($major < 3 && $^O eq 'openbsd'
1870         && !extract_from_file('pp_sys.c', qr/BSD_GETPGRP/)) {
1871         # Part of commit c3293030fd1b7489
1872         apply_patch(<<'EOPATCH');
1873 diff --git a/pp_sys.c b/pp_sys.c
1874 index 4608a2a..f0c9d1d 100644
1875 --- a/pp_sys.c
1876 +++ b/pp_sys.c
1877 @@ -2903,8 +2903,8 @@ PP(pp_getpgrp)
1878         pid = 0;
1879      else
1880         pid = SvIVx(POPs);
1881 -#ifdef USE_BSDPGRP
1882 -    value = (I32)getpgrp(pid);
1883 +#ifdef BSD_GETPGRP
1884 +    value = (I32)BSD_GETPGRP(pid);
1885  #else
1886      if (pid != 0)
1887         DIE("POSIX getpgrp can't take an argument");
1888 @@ -2933,8 +2933,8 @@ PP(pp_setpgrp)
1889      }
1890
1891      TAINT_PROPER("setpgrp");
1892 -#ifdef USE_BSDPGRP
1893 -    SETi( setpgrp(pid, pgrp) >= 0 );
1894 +#ifdef BSD_SETPGRP
1895 +    SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
1896  #else
1897      if ((pgrp != 0) || (pid != 0)) {
1898         DIE("POSIX setpgrp can't take an argument");
1899 EOPATCH
1900     }
1901
1902     if ($major < 4 && $^O eq 'openbsd') {
1903         my $bad;
1904         # Need changes from commit a6e633defa583ad5.
1905         # Commits c07a80fdfe3926b5 and f82b3d4130164d5f changed the same part
1906         # of perl.h
1907
1908         if (extract_from_file('perl.h',
1909                               qr/^#ifdef HAS_GETPGRP2$/)) {
1910             $bad = <<'EOBAD';
1911 ***************
1912 *** 57,71 ****
1913   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
1914   #define TAINT_ENV()   if (tainting) taint_env()
1915
1916 ! #ifdef HAS_GETPGRP2
1917 ! #   ifndef HAS_GETPGRP
1918 ! #     define HAS_GETPGRP
1919 ! #   endif
1920 ! #endif
1921 !
1922 ! #ifdef HAS_SETPGRP2
1923 ! #   ifndef HAS_SETPGRP
1924 ! #     define HAS_SETPGRP
1925 ! #   endif
1926   #endif
1927
1928 EOBAD
1929         } elsif (extract_from_file('perl.h',
1930                                    qr/Gack, you have one but not both of getpgrp2/)) {
1931             $bad = <<'EOBAD';
1932 ***************
1933 *** 56,76 ****
1934   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
1935   #define TAINT_ENV()   if (tainting) taint_env()
1936
1937 ! #if defined(HAS_GETPGRP2) && defined(HAS_SETPGRP2)
1938 ! #   define getpgrp getpgrp2
1939 ! #   define setpgrp setpgrp2
1940 ! #   ifndef HAS_GETPGRP
1941 ! #     define HAS_GETPGRP
1942 ! #   endif
1943 ! #   ifndef HAS_SETPGRP
1944 ! #     define HAS_SETPGRP
1945 ! #   endif
1946 ! #   ifndef USE_BSDPGRP
1947 ! #     define USE_BSDPGRP
1948 ! #   endif
1949 ! #else
1950 ! #   if defined(HAS_GETPGRP2) || defined(HAS_SETPGRP2)
1951 !       #include "Gack, you have one but not both of getpgrp2() and setpgrp2()."
1952 ! #   endif
1953   #endif
1954
1955 EOBAD
1956         } elsif (extract_from_file('perl.h',
1957                                    qr/^#ifdef USE_BSDPGRP$/)) {
1958             $bad = <<'EOBAD'
1959 ***************
1960 *** 91,116 ****
1961   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
1962   #define TAINT_ENV()   if (tainting) taint_env()
1963
1964 ! #ifdef USE_BSDPGRP
1965 ! #   ifdef HAS_GETPGRP
1966 ! #       define BSD_GETPGRP(pid) getpgrp((pid))
1967 ! #   endif
1968 ! #   ifdef HAS_SETPGRP
1969 ! #       define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
1970 ! #   endif
1971 ! #else
1972 ! #   ifdef HAS_GETPGRP2
1973 ! #       define BSD_GETPGRP(pid) getpgrp2((pid))
1974 ! #       ifndef HAS_GETPGRP
1975 ! #         define HAS_GETPGRP
1976 ! #     endif
1977 ! #   endif
1978 ! #   ifdef HAS_SETPGRP2
1979 ! #       define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
1980 ! #       ifndef HAS_SETPGRP
1981 ! #         define HAS_SETPGRP
1982 ! #     endif
1983 ! #   endif
1984   #endif
1985
1986   #ifndef _TYPES_               /* If types.h defines this it's easy. */
1987 EOBAD
1988         }
1989         if ($bad) {
1990             apply_patch(<<"EOPATCH");
1991 *** a/perl.h    2011-10-21 09:46:12.000000000 +0200
1992 --- b/perl.h    2011-10-21 09:46:12.000000000 +0200
1993 $bad--- 91,144 ----
1994   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
1995   #define TAINT_ENV()   if (tainting) taint_env()
1996
1997 ! /* XXX All process group stuff is handled in pp_sys.c.  Should these
1998 !    defines move there?  If so, I could simplify this a lot. --AD  9/96.
1999 ! */
2000 ! /* Process group stuff changed from traditional BSD to POSIX.
2001 !    perlfunc.pod documents the traditional BSD-style syntax, so we'll
2002 !    try to preserve that, if possible.
2003 ! */
2004 ! #ifdef HAS_SETPGID
2005 ! #  define BSD_SETPGRP(pid, pgrp)      setpgid((pid), (pgrp))
2006 ! #else
2007 ! #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
2008 ! #    define BSD_SETPGRP(pid, pgrp)    setpgrp((pid), (pgrp))
2009 ! #  else
2010 ! #    ifdef HAS_SETPGRP2  /* DG/UX */
2011 ! #      define BSD_SETPGRP(pid, pgrp)  setpgrp2((pid), (pgrp))
2012 ! #    endif
2013 ! #  endif
2014 ! #endif
2015 ! #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
2016 ! #  define HAS_SETPGRP  /* Well, effectively it does . . . */
2017 ! #endif
2018 !
2019 ! /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
2020 !     our life easier :-) so we'll try it.
2021 ! */
2022 ! #ifdef HAS_GETPGID
2023 ! #  define BSD_GETPGRP(pid)            getpgid((pid))
2024 ! #else
2025 ! #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
2026 ! #    define BSD_GETPGRP(pid)          getpgrp((pid))
2027 ! #  else
2028 ! #    ifdef HAS_GETPGRP2  /* DG/UX */
2029 ! #      define BSD_GETPGRP(pid)                getpgrp2((pid))
2030 ! #    endif
2031 ! #  endif
2032 ! #endif
2033 ! #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
2034 ! #  define HAS_GETPGRP  /* Well, effectively it does . . . */
2035 ! #endif
2036 !
2037 ! /* These are not exact synonyms, since setpgrp() and getpgrp() may
2038 !    have different behaviors, but perl.h used to define USE_BSDPGRP
2039 !    (prior to 5.003_05) so some extension might depend on it.
2040 ! */
2041 ! #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
2042 ! #  ifndef USE_BSDPGRP
2043 ! #    define USE_BSDPGRP
2044 ! #  endif
2045   #endif
2046
2047   #ifndef _TYPES_               /* If types.h defines this it's easy. */
2048 EOPATCH
2049         }
2050     }
2051
2052     if ($major == 4 && extract_from_file('scope.c', qr/\(SV\*\)SSPOPINT/)) {
2053         # [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void)
2054         # Fixes a bug introduced in 161b7d1635bc830b
2055         apply_commit('9002cb76ec83ef7f');
2056     }
2057
2058     if ($major == 4 && extract_from_file('av.c', qr/AvARRAY\(av\) = 0;/)) {
2059         # Fixes a bug introduced in 1393e20655efb4bc
2060         apply_commit('e1c148c28bf3335b', 'av.c');
2061     }
2062
2063     if ($major == 4) {
2064         my $rest = extract_from_file('perl.c', qr/delimcpy(.*)/);
2065         if (defined $rest and $rest !~ /,$/) {
2066             # delimcpy added in fc36a67e8855d031, perl.c refactored to use it.
2067             # bug introduced in 2a92aaa05aa1acbf, fixed in 8490252049bf42d3
2068             # code then moved to util.c in commit 491527d0220de34e
2069             apply_patch(<<'EOPATCH');
2070 diff --git a/perl.c b/perl.c
2071 index 4eb69e3..54bbb00 100644
2072 --- a/perl.c
2073 +++ b/perl.c
2074 @@ -1735,7 +1735,7 @@ SV *sv;
2075             if (len < sizeof tokenbuf)
2076                 tokenbuf[len] = '\0';
2077  #else  /* ! (atarist || DOSISH) */
2078 -           s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend
2079 +           s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
2080                          ':',
2081                          &len);
2082  #endif /* ! (atarist || DOSISH) */
2083 EOPATCH
2084         }
2085     }
2086
2087     if ($major == 4 && $^O eq 'linux') {
2088         # Whilst this is fixed properly in f0784f6a4c3e45e1 which provides the
2089         # Configure probe, it's easier to back out the problematic changes made
2090         # in these previous commits:
2091         if (extract_from_file('doio.c',
2092                               qr!^/\* XXX REALLY need metaconfig test \*/$!)) {
2093             revert_commit('4682965a1447ea44', 'doio.c');
2094         }
2095         if (my $token = extract_from_file('doio.c',
2096                                           qr!^#if (defined\(__sun(?:__)?\)) && defined\(__svr4__\) /\* XXX Need metaconfig test \*/$!)) {
2097             my $patch = `git show -R 9b599b2a63d2324d doio.c`;
2098             $patch =~ s/defined\(__sun__\)/$token/g;
2099             apply_patch($patch);
2100         }
2101         if (extract_from_file('doio.c',
2102                               qr!^/\* linux \(and Solaris2\?\) uses :$!)) {
2103             revert_commit('8490252049bf42d3', 'doio.c');
2104         }
2105         if (extract_from_file('doio.c',
2106                               qr/^          unsemds.buf = &semds;$/)) {
2107             revert_commit('8e591e46b4c6543e');
2108         }
2109         if (extract_from_file('doio.c',
2110                               qr!^#ifdef __linux__      /\* XXX Need metaconfig test \*/$!)) {
2111             # Reverts part of commit 3e3baf6d63945cb6
2112             apply_patch(<<'EOPATCH');
2113 diff --git b/doio.c a/doio.c
2114 index 62b7de9..0d57425 100644
2115 --- b/doio.c
2116 +++ a/doio.c
2117 @@ -1333,9 +1331,6 @@ SV **sp;
2118      char *a;
2119      I32 id, n, cmd, infosize, getinfo;
2120      I32 ret = -1;
2121 -#ifdef __linux__       /* XXX Need metaconfig test */
2122 -    union semun unsemds;
2123 -#endif
2124
2125      id = SvIVx(*++mark);
2126      n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
2127 @@ -1364,29 +1359,11 @@ SV **sp;
2128             infosize = sizeof(struct semid_ds);
2129         else if (cmd == GETALL || cmd == SETALL)
2130         {
2131 -#ifdef __linux__       /* XXX Need metaconfig test */
2132 -/* linux uses :
2133 -   int semctl (int semid, int semnun, int cmd, union semun arg)
2134 -
2135 -       union semun {
2136 -            int val;
2137 -            struct semid_ds *buf;
2138 -            ushort *array;
2139 -       };
2140 -*/
2141 -            union semun semds;
2142 -           if (semctl(id, 0, IPC_STAT, semds) == -1)
2143 -#else
2144             struct semid_ds semds;
2145             if (semctl(id, 0, IPC_STAT, &semds) == -1)
2146 -#endif
2147                 return -1;
2148             getinfo = (cmd == GETALL);
2149 -#ifdef __linux__       /* XXX Need metaconfig test */
2150 -           infosize = semds.buf->sem_nsems * sizeof(short);
2151 -#else
2152             infosize = semds.sem_nsems * sizeof(short);
2153 -#endif
2154                 /* "short" is technically wrong but much more portable
2155                    than guessing about u_?short(_t)? */
2156         }
2157 @@ -1429,12 +1406,7 @@ SV **sp;
2158  #endif
2159  #ifdef HAS_SEM
2160      case OP_SEMCTL:
2161 -#ifdef __linux__       /* XXX Need metaconfig test */
2162 -        unsemds.buf = (struct semid_ds *)a;
2163 -       ret = semctl(id, n, cmd, unsemds);
2164 -#else
2165         ret = semctl(id, n, cmd, (struct semid_ds *)a);
2166 -#endif
2167         break;
2168  #endif
2169  #ifdef HAS_SHM
2170 EOPATCH
2171         }
2172         # Incorrect prototype added as part of 8ac853655d9b7447, fixed as part
2173         # of commit dc45a647708b6c54, with at least one intermediate
2174         # modification. Correct prototype for gethostbyaddr has socklen_t
2175         # second. Linux has uint32_t first for getnetbyaddr.
2176         # Easiest just to remove, instead of attempting more complex patching.
2177         # Something similar may be needed on other platforms.
2178         edit_file('pp_sys.c', sub {
2179                       my $code = shift;
2180                       $code =~ s/^    struct hostent \*(?:PerlSock_)?gethostbyaddr\([^)]+\);$//m;
2181                       $code =~ s/^    struct netent \*getnetbyaddr\([^)]+\);$//m;
2182                       return $code;
2183                   });
2184     }
2185
2186     if ($major < 6 && $^O eq 'netbsd'
2187         && !extract_from_file('unixish.h',
2188                               qr/defined\(NSIG\).*defined\(__NetBSD__\)/)) {
2189         apply_patch(<<'EOPATCH')
2190 diff --git a/unixish.h b/unixish.h
2191 index 2a6cbcd..eab2de1 100644
2192 --- a/unixish.h
2193 +++ b/unixish.h
2194 @@ -89,7 +89,7 @@
2195   */
2196  /* #define ALTERNATE_SHEBANG "#!" / **/
2197
2198 -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
2199 +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
2200  # include <signal.h>
2201  #endif
2202
2203 EOPATCH
2204     }
2205
2206     if (($major >= 7 || $major <= 9) && $^O eq 'openbsd'
2207         && `uname -m` eq "sparc64\n"
2208         # added in 2000 by commit cb434fcc98ac25f5:
2209         && extract_from_file('regexec.c',
2210                              qr!/\* No need to save/restore up to this paren \*/!)
2211         # re-indented in 2006 by commit 95b2444054382532:
2212         && extract_from_file('regexec.c', qr/^\t\tCURCUR cc;$/)) {
2213         # Need to work around a bug in (at least) OpenBSD's 4.6's sparc64 #
2214         # compiler ["gcc (GCC) 3.3.5 (propolice)"]. Between commits
2215         # 3ec562b0bffb8b8b (2002) and 1a4fad37125bac3e^ (2005) the darling thing
2216         # fails to compile any code for the statement cc.oldcc = PL_regcc;
2217         #
2218         # If you refactor the code to "fix" that, or force the issue using set
2219         # in the debugger, the stack smashing detection code fires on return
2220         # from S_regmatch(). Turns out that the compiler doesn't allocate any
2221         # (or at least enough) space for cc.
2222         #
2223         # Restore the "uninitialised" value for cc before function exit, and the
2224         # stack smashing code is placated.  "Fix" 3ec562b0bffb8b8b (which
2225         # changes the size of auto variables used elsewhere in S_regmatch), and
2226         # the crash is visible back to bc517b45fdfb539b (which also changes
2227         # buffer sizes). "Unfix" 1a4fad37125bac3e and the crash is visible until
2228         # 5b47454deb66294b.  Problem goes away if you compile with -O, or hack
2229         # the code as below.
2230         #
2231         # Hence this turns out to be a bug in (old) gcc. Not a security bug we
2232         # still need to fix.
2233         apply_patch(<<'EOPATCH');
2234 diff --git a/regexec.c b/regexec.c
2235 index 900b491..6251a0b 100644
2236 --- a/regexec.c
2237 +++ b/regexec.c
2238 @@ -2958,7 +2958,11 @@ S_regmatch(pTHX_ regnode *prog)
2239                                 I,I
2240   *******************************************************************/
2241         case CURLYX: {
2242 -               CURCUR cc;
2243 +           union {
2244 +               CURCUR hack_cc;
2245 +               char hack_buff[sizeof(CURCUR) + 1];
2246 +           } hack;
2247 +#define cc hack.hack_cc
2248                 CHECKPOINT cp = PL_savestack_ix;
2249                 /* No need to save/restore up to this paren */
2250                 I32 parenfloor = scan->flags;
2251 @@ -2983,6 +2987,7 @@ S_regmatch(pTHX_ regnode *prog)
2252                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
2253                 regcpblow(cp);
2254                 PL_regcc = cc.oldcc;
2255 +#undef cc
2256                 saySAME(n);
2257             }
2258             /* NOT REACHED */
2259 EOPATCH
2260 }
2261
2262     if ($major < 8 && $^O eq 'openbsd'
2263         && !extract_from_file('perl.h', qr/include <unistd\.h>/)) {
2264         # This is part of commit 3f270f98f9305540, applied at a slightly
2265         # different location in perl.h, where the context is stable back to
2266         # 5.000
2267         apply_patch(<<'EOPATCH');
2268 diff --git a/perl.h b/perl.h
2269 index 9418b52..b8b1a7c 100644
2270 --- a/perl.h
2271 +++ b/perl.h
2272 @@ -496,6 +496,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
2273  #   include <sys/param.h>
2274  #endif
2275
2276 +/* If this causes problems, set i_unistd=undef in the hint file.  */
2277 +#ifdef I_UNISTD
2278 +#   include <unistd.h>
2279 +#endif
2280
2281  /* Use all the "standard" definitions? */
2282  #if defined(STANDARD_C) && defined(I_STDLIB)
2283 EOPATCH
2284     }
2285 }
2286
2287 sub patch_ext {
2288     if (-f 'ext/POSIX/Makefile.PL'
2289         && extract_from_file('ext/POSIX/Makefile.PL',
2290                              qr/Explicitly avoid including/)) {
2291         # commit 6695a346c41138df, which effectively reverts 170888cff5e2ffb7
2292
2293         # PERL5LIB is populated by make_ext.pl with paths to the modules we need
2294         # to run, don't override this with "../../lib" since that may not have
2295         # been populated yet in a parallel build.
2296         apply_commit('6695a346c41138df');
2297     }
2298
2299     if ($major < 8 && $^O eq 'darwin' && !-f 'ext/DynaLoader/dl_dyld.xs') {
2300         checkout_file('ext/DynaLoader/dl_dyld.xs', 'f556e5b971932902');
2301         apply_patch(<<'EOPATCH');
2302 diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
2303 --- a/ext/DynaLoader/dl_dyld.xs~        2011-10-11 21:41:27.000000000 +0100
2304 +++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:42:20.000000000 +0100
2305 @@ -41,6 +41,35 @@
2306  #include "perl.h"
2307  #include "XSUB.h"
2308
2309 +#ifndef pTHX
2310 +#  define pTHX         void
2311 +#  define pTHX_
2312 +#endif
2313 +#ifndef aTHX
2314 +#  define aTHX
2315 +#  define aTHX_
2316 +#endif
2317 +#ifndef dTHX
2318 +#  define dTHXa(a)     extern int Perl___notused(void)
2319 +#  define dTHX         extern int Perl___notused(void)
2320 +#endif
2321 +
2322 +#ifndef Perl_form_nocontext
2323 +#  define Perl_form_nocontext form
2324 +#endif
2325 +
2326 +#ifndef Perl_warn_nocontext
2327 +#  define Perl_warn_nocontext warn
2328 +#endif
2329 +
2330 +#ifndef PTR2IV
2331 +#  define PTR2IV(p)    (IV)(p)
2332 +#endif
2333 +
2334 +#ifndef get_av
2335 +#  define get_av perl_get_av
2336 +#endif
2337 +
2338  #define DL_LOADONCEONLY
2339
2340  #include "dlutils.c"   /* SaveError() etc      */
2341 @@ -185,7 +191,7 @@
2342      CODE:
2343      DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
2344      if (flags & 0x01)
2345 -       Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
2346 +       Perl_warn_nocontext("Can't make loaded symbols global on this platform while loading %s",filename);
2347      RETVAL = dlopen(filename, mode) ;
2348      DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
2349      ST(0) = sv_newmortal() ;
2350 EOPATCH
2351         if ($major < 4 && !extract_from_file('util.c', qr/^form/m)) {
2352             apply_patch(<<'EOPATCH');
2353 diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
2354 --- a/ext/DynaLoader/dl_dyld.xs~        2011-10-11 21:56:25.000000000 +0100
2355 +++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 22:00:00.000000000 +0100
2356 @@ -60,6 +60,18 @@
2357  #  define get_av perl_get_av
2358  #endif
2359
2360 +static char *
2361 +form(char *pat, ...)
2362 +{
2363 +    char *retval;
2364 +    va_list args;
2365 +    va_start(args, pat);
2366 +    vasprintf(&retval, pat, &args);
2367 +    va_end(args);
2368 +    SAVEFREEPV(retval);
2369 +    return retval;
2370 +}
2371 +
2372  #define DL_LOADONCEONLY
2373
2374  #include "dlutils.c"   /* SaveError() etc      */
2375 EOPATCH
2376         }
2377     }
2378
2379     if ($major < 10) {
2380         if (!extract_from_file('ext/DB_File/DB_File.xs',
2381                                qr!^#else /\* Berkeley DB Version > 2 \*/$!)) {
2382             # This DB_File.xs is really too old to patch up.
2383             # Skip DB_File, unless we're invoked with an explicit -Unoextensions
2384             if (!exists $defines{noextensions}) {
2385                 $defines{noextensions} = 'DB_File';
2386             } elsif (defined $defines{noextensions}) {
2387                 $defines{noextensions} .= ' DB_File';
2388             }
2389         } elsif (!extract_from_file('ext/DB_File/DB_File.xs',
2390                                     qr/^#ifdef AT_LEAST_DB_4_1$/)) {
2391             # This line is changed by commit 3245f0580c13b3ab
2392             my $line = extract_from_file('ext/DB_File/DB_File.xs',
2393                                          qr/^(        status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/);
2394             apply_patch(<<"EOPATCH");
2395 diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
2396 index 489ba96..fba8ded 100644
2397 --- a/ext/DB_File/DB_File.xs
2398 +++ b/ext/DB_File/DB_File.xs
2399 \@\@ -183,4 +187,8 \@\@
2400  #endif
2401
2402 +#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
2403 +#    define AT_LEAST_DB_4_1
2404 +#endif
2405 +
2406  /* map version 2 features & constants onto their version 1 equivalent */
2407
2408 \@\@ -1334,7 +1419,12 \@\@ SV *   sv ;
2409  #endif
2410
2411 +#ifdef AT_LEAST_DB_4_1
2412 +        status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
2413 +                               Flags, mode) ;
2414 +#else
2415  $line
2416                                 Flags, mode) ;
2417 +#endif
2418         /* printf("open returned %d %s\\n", status, db_strerror(status)) ; */
2419
2420 EOPATCH
2421         }
2422     }
2423
2424     if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') {
2425         edit_file('ext/IPC/SysV/SysV.xs', sub {
2426                       my $xs = shift;
2427                       my $fixed = <<'EOFIX';
2428
2429 #include <sys/types.h>
2430 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
2431 #ifndef HAS_SEM
2432 #   include <sys/ipc.h>
2433 #endif
2434 #   ifdef HAS_MSG
2435 #       include <sys/msg.h>
2436 #   endif
2437 #   ifdef HAS_SHM
2438 #       if defined(PERL_SCO) || defined(PERL_ISC)
2439 #           include <sys/sysmacros.h>   /* SHMLBA */
2440 #       endif
2441 #      include <sys/shm.h>
2442 #      ifndef HAS_SHMAT_PROTOTYPE
2443            extern Shmat_t shmat (int, char *, int);
2444 #      endif
2445 #      if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
2446 #          undef  SHMLBA /* not static: determined at boot time */
2447 #          define SHMLBA sysconf(_SC_PAGESIZE)
2448 #      elif defined(HAS_GETPAGESIZE)
2449 #          undef  SHMLBA /* not static: determined at boot time */
2450 #          define SHMLBA getpagesize()
2451 #      endif
2452 #   endif
2453 #endif
2454 EOFIX
2455                       $xs =~ s!
2456 #include <sys/types\.h>
2457 .*
2458 (#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms;
2459                       return $xs;
2460                   });
2461     }
2462 }
2463
2464 # Local variables:
2465 # cperl-indent-level: 4
2466 # indent-tabs-mode: nil
2467 # End:
2468 #
2469 # ex: set ts=8 sts=4 sw=4 et: