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