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