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