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