Porting/bisect-runner.pl

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