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