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