xref: /openbsd-src/gnu/usr.bin/perl/Porting/bisect-runner.pl (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1#!/usr/bin/perl -w
2use strict;
3
4use Getopt::Long qw(:config bundling no_auto_abbrev);
5use Pod::Usage;
6use Config;
7use File::Temp qw(tempdir);
8use File::Spec;
9
10my @targets
11    = qw(none config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep);
12
13my %options =
14    (
15     'expect-pass' => 1,
16     clean => 1, # mostly for debugging this
17    );
18
19# We accept #!./miniperl and #!./perl
20# We don't accept #!miniperl and #!perl as their intent is ambiguous
21my $run_with_our_perl = qr{\A#!(\./(?:mini)?perl)\b};
22
23my $linux64 = `uname -sm` eq "Linux x86_64\n" ? '64' : '';
24
25my @paths;
26
27if ($^O eq 'linux') {
28    # This is the search logic for a multi-arch library layout
29    # added to linux.sh in commits 40f026236b9959b7 and dcffd848632af2c7.
30    my $gcc = -x '/usr/bin/gcc' ? '/usr/bin/gcc' : 'gcc';
31
32    foreach (`$gcc -print-search-dirs`) {
33        next unless /^libraries: =(.*)/;
34        foreach (split ':', $1) {
35            next if m/gcc/;
36            next unless -d $_;
37            s!/$!!;
38            push @paths, $_;
39        }
40    }
41    push @paths, map {$_ . $linux64} qw(/usr/local/lib /lib /usr/lib)
42        if $linux64;
43}
44
45my %defines =
46    (
47     usedevel => '',
48     optimize => '-g',
49     ld => 'cc',
50     (@paths ? (libpth => \@paths) : ()),
51    );
52
53# Needed for the 'ignore_versioned_solibs' emulation below.
54push @paths, qw(/usr/local/lib /lib /usr/lib)
55        unless $linux64;
56
57my $rv = GetOptions(
58    \%options,
59    'target=s', 'make=s', 'jobs|j=i', 'crash', 'expect-pass=i',
60    'expect-fail' => sub { $options{'expect-pass'} = 0; },
61    'clean!', 'one-liner|e=s@', 'c', 'l', 'w', 'match=s',
62    'no-match=s' => sub {
63        $options{match} = $_[1];
64        $options{'expect-pass'} = 0;
65    },
66    'force-manifest', 'force-regen', 'setpgrp!', 'timeout=i',
67    'test-build', 'validate',
68    'all-fixups', 'early-fixup=s@', 'late-fixup=s@', 'valgrind',
69    'check-args', 'check-shebang!', 'usage|help|?', 'gold=s',
70    'module=s', 'with-module=s', 'cpan-config-dir=s',
71    'test-module=s', 'no-module-tests',
72    'A=s@',
73    'D=s@' => sub {
74        my (undef, $val) = @_;
75        if ($val =~ /\A([^=]+)=(.*)/s) {
76            $defines{$1} = length $2 ? $2 : "\0";
77        } else {
78            $defines{$val} = '';
79        }
80    },
81    'U=s@' => sub {
82        $defines{$_[1]} = undef;
83    },
84);
85exit 255 unless $rv;
86
87my ($target, $match) = @options{qw(target match)};
88
89# El Capitan (OS X 10.11) (and later) strip DYLD_LIBRARY_PATH
90# from the environment of /bin/sh
91# https://developer.apple.com/library/archive/documentation/Security/Conceptual/System_Integrity_Protection_Guide/RuntimeProtections/RuntimeProtections.html
92#
93# (They *could* have chosen instead to ignore it and pass it through. It would
94# have the same direct effect, but maybe needing more coding. I suspect the
95# choice to strip it was deliberate, as it will also eliminate a bunch more
96# attack vectors, because it prevents you sneaking an override "into" something
97# else you convince the user to run.)
98
99my $aggressive_apple_security = "";
100if ($^O eq 'darwin') {
101    require Cwd;
102    my $cwd = quotemeta Cwd::getcwd();
103    $aggressive_apple_security = "DYLD_LIBRARY_PATH=$cwd ";
104}
105
106@ARGV = ('sh', '-c', "cd t && $aggressive_apple_security./perl TEST base/*.t")
107    if $options{validate} && !@ARGV;
108
109pod2usage(exitval => 0, verbose => 2) if $options{usage};
110
111# This needs to be done before the next arguments check, as it's populating
112# @ARGV
113if (defined $target && $target =~ /\.t\z/) {
114    # t/TEST don't have a reliable way to run the test script under valgrind
115    # The $ENV{VALGRIND} code was only added after v5.8.0, and is more
116    # geared to logging than to exiting on failure if errors are found.
117    # I guess one could fudge things by replacing the symlink t/perl with a
118    # wrapper script which invokes valgrind, but leave doing that until
119    # someone needs it. (If that's you, then patches welcome.)
120    foreach (qw(valgrind match validate test-build one-liner)) {
121        die_255("$0: Test-case targets can't be run with --$_")
122            if $options{$_};
123    }
124    die_255("$0: Test-case targets can't be combined with an explicit test")
125        if @ARGV;
126
127    # Needing this unless is a smell suggesting that this implementation of
128    # test-case targets is not really in the right place.
129    unless ($options{'check-args'}) {
130        # The top level sanity tests refuse to start or end a test run at a
131        # revision which skips, hence this test ensures reasonable sanity at
132        # automatically picking a suitable start point for both normal operation
133        # and --expect-fail
134        skip("Test case $target is not a readable file")
135            unless -f $target && -r _;
136    }
137
138    # t/TEST runs from and takes pathnames relative to t/, so need to strip
139    # out a leading t, or add ../ otherwise
140    unless ($target =~ s!\At/!!) {
141        $target = "../$target";
142    }
143    @ARGV = ('sh', '-c', "cd t && $aggressive_apple_security./perl TEST " . quotemeta $target);
144    $target = 'test_prep';
145}
146
147pod2usage(exitval => 255, verbose => 1)
148    unless @ARGV || $match || $options{'test-build'}
149        || defined $options{'one-liner'} || defined $options{module}
150        || defined $options{'test-module'};
151pod2usage(exitval => 255, verbose => 1)
152    if !$options{'one-liner'} && ($options{l} || $options{w});
153if ($options{'no-module-tests'} && $options{module}) {
154    print STDERR "--module and --no-module-tests are exclusive.\n\n";
155    pod2usage(exitval => 255, verbose => 1)
156}
157if ($options{'no-module-tests'} && $options{'test-module'}) {
158    print STDERR "--test-module and --no-module-tests are exclusive.\n\n";
159    pod2usage(exitval => 255, verbose => 1)
160}
161if ($options{module} && $options{'test-module'}) {
162    print STDERR "--module and --test-module are exclusive.\n\n";
163    pod2usage(exitval => 255, verbose => 1)
164}
165
166check_shebang($ARGV[0])
167    if $options{'check-shebang'} && @ARGV && !$options{match};
168
169exit 0 if $options{'check-args'};
170
171=head1 NAME
172
173bisect.pl - use git bisect to pinpoint changes
174
175=head1 SYNOPSIS
176
177 # When did this become an error?
178 .../Porting/bisect.pl -e 'my $a := 2;'
179 # When did this stop being an error?
180 .../Porting/bisect.pl --expect-fail -e '1 // 2'
181 # When did this test start failing?
182 .../Porting/bisect.pl --target t/op/sort.t
183 # When were all lines matching this pattern removed from all files?
184 .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b'
185 # When was some line matching this pattern added to some file?
186 .../Porting/bisect.pl --expect-fail --match '\buseithreads\b'
187 # When did this test program stop exiting 0?
188 .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl
189 # When did this test program start crashing (any signal or coredump)?
190 .../Porting/bisect.pl --crash -- ./perl -Ilib ../test_prog.pl
191 # When did this first become valid syntax?
192 .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \
193      --expect-fail -e 'my $a := 2;'
194 # What was the last revision to build with these options?
195 .../Porting/bisect.pl --test-build -Dd_dosuid
196 # When did this test program start generating errors from valgrind?
197 .../Porting/bisect.pl --valgrind ../test_prog.pl
198 # When did these cpan modules start failing to compile/pass tests?
199 .../Porting/bisect.pl --module=autobox,Moose
200 # When did this code stop working in blead with these modules?
201 .../Porting/bisect.pl --with-module=Moose,Moo -e 'use Moose; 1;'
202 # Like the above 2 but with custom CPAN::MyConfig
203 .../Porting/bisect.pl --module=Moo --cpan-config-dir=/home/blah/custom/
204
205=head1 DESCRIPTION
206
207Together F<bisect.pl> and F<bisect-runner.pl> attempt to automate the use
208of C<git bisect> as much as possible. With one command (and no other files)
209it's easy to find out
210
211=over 4
212
213=item *
214
215Which commit caused this example code to break?
216
217=item *
218
219Which commit caused this example code to start working?
220
221=item *
222
223Which commit added the first file to match this regex?
224
225=item *
226
227Which commit removed the last file to match this regex?
228
229=back
230
231usually without needing to know which versions of perl to use as start and
232end revisions.
233
234By default F<bisect.pl> will process all options, then use the rest of the
235command line as arguments to list C<system> to run a test case. By default,
236the test case should pass (exit with 0) on earlier perls, and fail (exit
237non-zero) on I<blead>. F<bisect.pl> will use F<bisect-runner.pl> to find the
238earliest stable perl version on which the test case passes, check that it
239fails on blead, and then use F<bisect-runner.pl> with C<git bisect run> to
240find the commit which caused the failure.
241
242Many of perl's own test scripts exit 0 even if their TAP reports test
243failures, and some need particular setup (such as running from the right
244directory, or adding C<-T> to the command line). Hence if you want to bisect
245a test script, you can specify it with the I<--target> option, and it will
246be invoked using F<t/TEST> which performs all the setup, and exits non-zero
247if the TAP reports failures. This works for any file ending C<.t>, so you can
248use it with a file outside of the working checkout, for example to test a
249particular version of a test script, as a path inside the repository will
250(of course) be testing the version of the script checked out for the current
251revision, which may be too early to have the test you are interested in.
252
253Because the test case is the complete argument to C<system>, it is easy to
254run something other than the F<perl> built, if necessary. If you need to run
255the perl built, you'll probably need to invoke it as C<./perl -Ilib ...>.
256As a special case, if the first argument of the test case is a readable file
257(whether executable or not), matching C<qr{\A#!./(?:mini)?perl\b}> then it
258will have C<./perl> <-Ilib> (or C<./miniperl>) prepended to it.
259
260You need a clean checkout to run a bisect. You can use the checkout
261containing F<Porting/bisect.pl> if you wish - in this case
262F<Porting/bisect.pl> will copy F<Porting/bisect-runner.pl> to a temporary
263file generated by C<File::Temp::tempfile()>. If doing this, beware that when
264the bisect ends (or you abort it) then your checkout is no longer at
265C<blead>, so you will need to C<git checkout blead> before restarting, to
266get the current version of F<Porting/bisect.pl> again. It's often easier
267either to copy F<Porting/bisect.pl> and F<Porting/bisect-runner.pl> to
268another directory (I<e.g.> F<~/bin>, if you have one), or to create a second
269git repository for running bisect. To create a second local repository, if
270your working checkout is called F<perl>, a simple solution is to make a
271local clone, and run from that. I<i.e.>:
272
273    cd ..
274    git clone perl perl2
275    cd perl2
276    ../perl/Porting/bisect.pl ...
277
278By default, F<bisect-runner.pl> will automatically disable the build of
279L<DB_File> for commits earlier than ccb44e3bf3be2c30, as it's not practical
280to patch DB_File 1.70 and earlier to build with current Berkeley DB headers.
281(ccb44e3bf3be2c30 was in September 1999, between 5.005_62 and 5.005_63.)
282If your F<db.h> is old enough you can override this with C<-Unoextensions>.
283
284=head1 OPTIONS
285
286=over 4
287
288=item *
289
290--start I<commit-ish>
291
292Earliest revision to test, as a I<commit-ish> (a tag, commit or anything
293else C<git> understands as a revision). If not specified, F<bisect.pl> will
294search stable .0 perl releases until it finds one where the test case
295passes. The default is to search from 5.002 to the most recent tagged stable
296release (v5.18.0 at the time of writing). If F<bisect.pl> detects that the
297checkout is on a case insensitive file system, it will search from 5.005 to
298the most recent tagged stable release. Only .0 stable releases are used
299because these are the only stable releases that are parents of blead, and
300hence suitable for a bisect run.
301
302=item *
303
304--end I<commit-ish>
305
306Most recent revision to test, as a I<commit-ish>. If not specified, defaults
307to I<blead>.
308
309=item *
310
311--target I<target>
312
313F<Makefile> target (or equivalent) needed, to run the test case. If specified,
314this should be one of
315
316=over 4
317
318=item *
319
320I<none>
321
322Don't build anything - just run the user test case against a clean checkout.
323Using this gives a couple of features that a plain C<git bisect run> can't
324offer - automatic start revision detection, and test case C<--timeout>.
325
326=item *
327
328I<config.sh>
329
330Just run F<./Configure>
331
332=item *
333
334I<config.h>
335
336Run the various F<*.SH> files to generate F<Makefile>, F<config.h>, I<etc>.
337
338=item *
339
340I<miniperl>
341
342Build F<miniperl>.
343
344=item *
345
346I<lib/Config.pm>
347
348Use F<miniperl> to build F<lib/Config.pm>
349
350=item *
351
352I<Fcntl>
353
354Build F<lib/auto/Fcntl/Fnctl.so> (strictly, C<.$Config{so}>). As L<Fcntl>
355is simple XS module present since 5.000, this provides a fast test of
356whether XS modules can be built. Note, XS modules are built by F<miniperl>,
357hence this target will not build F<perl>.
358
359=item *
360
361I<perl>
362
363Build F<perl>. This also builds pure-Perl modules in F<cpan>, F<dist> and
364F<ext>. XS modules (such as L<Fcntl>) are not built.
365
366=item *
367
368I<test_prep>
369
370Build everything needed to run the tests. This is the default if we're
371running test code, but is time consuming, as it means building all
372XS modules. For older F<Makefile>s, the previous name of C<test-prep>
373is automatically substituted. For very old F<Makefile>s, C<make test> is
374run, as there is no target provided to just get things ready, and for 5.004
375and earlier the tests run very quickly.
376
377=item *
378
379A file ending C<.t>
380
381Build everything needed to run the tests, and then run this test script using
382F<t/TEST>. This is actually implemented internally by using the target
383I<test_prep>, and setting the test case to "sh", "-c", "cd t && ./TEST ..."
384
385=back
386
387=item *
388
389--one-liner 'code to run'
390
391=item *
392
393-e 'code to run'
394
395Example code to run, just like you'd use with C<perl -e>.
396
397This prepends C<./perl -Ilib -e 'code to run'> to the test case given,
398or F<./miniperl> if I<target> is C<miniperl>.
399
400(Usually you'll use C<-e> instead of providing a test case in the
401non-option arguments to F<bisect.pl>. You can repeat C<-e> on the command
402line, just like you can with C<perl>)
403
404C<-E> intentionally isn't supported, as it's an error in 5.8.0 and earlier,
405which interferes with detecting errors in the example code itself.
406
407=item *
408
409-c
410
411Add C<-c> to the command line, to cause perl to exit after syntax checking.
412
413=item *
414
415-l
416
417Add C<-l> to the command line with C<-e>
418
419This will automatically append a newline to every output line of your testcase.
420Note that you can't specify an argument to F<perl>'s C<-l> with this, as it's
421not feasible to emulate F<perl>'s somewhat quirky switch parsing with
422L<Getopt::Long>. If you need the full flexibility of C<-l>, you need to write
423a full test case, instead of using C<bisect.pl>'s C<-e> shortcut.
424
425=item *
426
427-w
428
429Add C<-w> to the command line with C<-e>
430
431It's not valid to pass C<-c>,  C<-l> or C<-w> to C<bisect.pl> unless you are
432also using C<-e>
433
434=item *
435
436--expect-fail
437
438The test case should fail for the I<start> revision, and pass for the I<end>
439revision. The bisect run will find the first commit where it passes.
440
441=item *
442
443--crash
444
445Treat any non-crash as success, any crash as failure. (Crashing defined
446as exiting with a signal or a core dump.)
447
448=item *
449
450-D I<config_arg=value>
451
452=item *
453
454-U I<config_arg>
455
456=item *
457
458-A I<config_arg=value>
459
460Arguments (C<-A>, C<-D>, C<-U>) to pass to F<Configure>.  The C<-D>, C<-A> and
461C<-U> switches should be spelled as if you were normally giving them to
462F<./Configure>.  For example,
463
464    -Dnoextensions=Encode
465    -Uusedevel
466    -Accflags=-DNO_MATHOMS
467
468Repeated C<-A> arguments are passed
469through as is. C<-D> and C<-U> are processed in order, and override
470previous settings for the same parameter. F<bisect-runner.pl> emulates
471C<-Dnoextensions> when F<Configure> itself does not provide it, as it's
472often very useful to be able to disable some XS extensions.
473
474=item *
475
476--make I<make-prog>
477
478The C<make> command to use. If this not set, F<make> is used. If this is
479set, it also adds a C<-Dmake=...> else some recursive make invocations
480in extensions may fail. Typically one would use this as C<--make gmake>
481to use F<gmake> in place of the system F<make>.
482
483=item *
484
485--jobs I<jobs>
486
487=item *
488
489-j I<jobs>
490
491Number of C<make> jobs to run in parallel. A value of 0 suppresses
492parallelism. If F</proc/cpuinfo> exists and can be parsed, or F</sbin/sysctl>
493exists and reports C<hw.ncpu>, or F</usr/bin/getconf> exists and reports
494C<_NPROCESSORS_ONLN> defaults to 1 + I<number of CPUs>. On HP-UX with the
495system make defaults to 0, otherwise defaults to 2.
496
497=item *
498
499--match pattern
500
501=item *
502
503--no-match pattern
504
505Instead of running a test program to determine I<pass> or I<fail>,
506C<--match> will pass if the given regex matches, and hence search for the
507commit that removes the last matching file. C<--no-match> inverts the test,
508to search for the first commit that adds files that match.
509
510The remaining command line arguments are treated as glob patterns for files
511to match against. If none are specified, then they default as follows:
512
513=over 4
514
515=item *
516
517If no I<target> is specified, the match is against all files in the
518repository (which is fast).
519
520=item *
521
522If a I<target> is specified, that target is built, and the match is against
523only the built files.
524
525=back
526
527Treating the command line arguments as glob patterns should not cause
528problems, as the perl distribution has never shipped or built files with
529names that contain characters which are globbing metacharacters.
530
531Anything which is not a readable file is ignored, instead of generating an
532error. (If you want an error, run C<grep> or C<ack> as a test case). This
533permits one to easily search in a file that changed its name. For example:
534
535    .../Porting/bisect.pl --match 'Pod.*Functions' 'pod/buildtoc*'
536
537C<--no-match ...> is implemented as C<--expect-fail --match ...>
538
539=item *
540
541--valgrind
542
543Run the test program under C<valgrind>. If you need to test for memory
544errors when parsing invalid programs, the default parser fail exit code of
545255 will always override C<valgrind>, so try putting the test case invalid
546code inside a I<string> C<eval>, so that the perl interpreter will exit with 0.
547(Be sure to check the output of $@, to avoid missing mistakes such as
548unintended C<eval> failures due to incorrect C<@INC>)
549
550Specifically, this option prepends C<valgrind> C<--error-exitcode=124> to
551the command line that runs the testcase, to cause valgrind to exit non-zero
552if it detects errors, with the assumption that the test program itself
553always exits with zero. If you require more flexibility than this, either
554specify your C<valgrind> invocation explicitly as part of the test case, or
555use a wrapper script to control the command line or massage the exit codes.
556
557In order for the test program to be seen as a perl script to valgrind
558(rather than a shell script), the first line must be one of the following
559
560  #!./perl
561  #!./miniperl
562
563=item *
564
565--test-build
566
567Test that the build completes, without running any test case.
568
569By default, if the build for the desired I<target> fails to complete,
570F<bisect-runner.pl> reports a I<skip> back to C<git bisect>, the assumption
571being that one wants to find a commit which changed state "builds && passes"
572to "builds && fails". If instead one is interested in which commit broke the
573build (possibly for particular F<Configure> options), use I<--test-build>
574to treat a build failure as a failure, not a "skip".
575
576Often this option isn't as useful as it first seems, because I<any> build
577failure will be reported to C<git bisect> as a failure, not just the failure
578that you're interested in. Generally, to debug a particular problem, it's
579more useful to use a I<target> that builds properly at the point of interest,
580and then a test case that runs C<make>. For example:
581
582    .../Porting/bisect.pl --start=perl-5.000 --end=perl-5.002 \
583        --expect-fail --force-manifest --target=miniperl make perl
584
585will find the first revision capable of building L<DynaLoader> and then
586F<perl>, without becoming confused by revisions where F<miniperl> won't
587even link.
588
589=item *
590
591--module module1,module2,...
592
593Install this (or these) module(s), die when it (the last of those)
594cannot be updated to the current version.
595
596Misnomer. the argument can be any argument that can be passed to CPAN
597shell's install command. B<But>: since we only have the uptodate
598command to verify that an install has taken place, we are unable to
599determine success for arguments like
600MSCHWERN/Test-Simple-1.005000_005.tar.gz.
601
602In so far, it is not such a misnomer.
603
604Note that this and I<--with-module> will both require a C<CPAN::MyConfig>.
605If F<$ENV{HOME}/.cpan/CPAN/MyConfig.pm> does not exist, a CPAN shell will
606be started up for you so you can configure one. Feel free to let
607CPAN pick defaults for you. Enter 'quit' when you are done, and
608then everything should be all set. Alternatively, you may
609specify a custom C<CPAN::MyConfig> by using I<--cpan-config-dir>.
610
611Also, if you want to bisect a module that needs a display (like
612TK) and you don't want random screens appearing and disappearing
613on your computer while you're working, you can do something like
614this:
615
616In a terminal:
617
618 $ while true; do date ; if ! ps auxww | grep -v grep \
619   | grep -q Xvfb; then Xvfb :121 & fi; echo -n 'sleeping 60 '; \
620   sleep 60; done
621
622And then:
623
624  DISPLAY=":121" .../Porting/bisect.pl --module=TK
625
626(Some display alternatives are vncserver and Xnest.)
627
628=item *
629
630--with-module module1,module2,...
631
632Like I<--module> above, except this simply installs the requested
633modules and they can then be used in other tests.
634
635For example:
636
637  .../Porting/bisect.pl --with-module=Moose -e 'use Moose; ...'
638
639=item *
640
641--no-module-tests
642
643Use in conjunction with I<--with-module> to install the modules without
644running their tests. This can be a big time saver.
645
646For example:
647
648  .../Porting/bisect.pl --with-module=Moose --no-module-tests \
649       -e 'use Moose; ...'
650
651=item *
652
653--test-module
654
655This is like I<--module>, but just runs the module's tests, instead of
656installing it.
657
658WARNING: This is a somewhat experimental option, known to work on recent
659CPAN shell versions.  If you use this option and strange things happen,
660please report them.
661
662Usually, you can just use I<--module>, but if you are getting inconsistent
663installation failures and you just want to see when the tests started
664failing, you might find this option useful.
665
666=item *
667
668--cpan-config-dir /home/blah/custom
669
670If defined, this will cause L<CPAN> to look for F<CPAN/MyConfig.pm> inside of
671the specified directory, instead of using the default config of
672F<$ENV{HOME}/.cpan/>.
673
674If no default config exists, a L<CPAN> shell will be fired up for you to
675configure things. Letting L<CPAN> automatically configure things for you
676should work well enough. You probably want to choose I<manual> instead of
677I<local::lib> if it asks. When you're finished with configuration, just
678type I<q> and hit I<ENTER> and the bisect should continue.
679
680=item *
681
682--force-manifest
683
684By default, a build will "skip" if any files listed in F<MANIFEST> are not
685present. Usually this is useful, as it avoids false-failures. However, there
686are some long ranges of commits where listed files are missing, which can
687cause a bisect to abort because all that remain are skipped revisions.
688
689In these cases, particularly if the test case uses F<miniperl> and no modules,
690it may be more useful to force the build to continue, even if files
691F<MANIFEST> are missing.
692
693=item *
694
695--force-regen
696
697Run C<make regen_headers> before building F<miniperl>. This may fix a build
698that otherwise would skip because the generated headers at that revision
699are stale. It's not the default because it conceals this error in the true
700state of such revisions.
701
702=item *
703
704--expect-pass [0|1]
705
706C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1> is the default.
707
708=item *
709
710--timeout I<seconds>
711
712Run the testcase with the given timeout. If this is exceeded, kill it (and
713by default all its children), and treat it as a failure.
714
715=item *
716
717--setpgrp
718
719Run the testcase in its own process group. Specifically, call C<setpgrp 0, 0>
720just before C<exec>-ing the user testcase. The default is not to set the
721process group, unless a timeout is used.
722
723=item *
724
725--all-fixups
726
727F<bisect-runner.pl> will minimally patch various files on a platform and
728version dependent basis to get the build to complete. Normally it defers
729doing this as long as possible - C<.SH> files aren't patched until after
730F<Configure> is run, and C<C> and C<XS> code isn't patched until after
731F<miniperl> is built. If C<--all-fixups> is specified, all the fixups are
732done before running C<Configure>. In rare cases adding this may cause a
733bisect to abort, because an inapplicable patch or other fixup is attempted
734for a revision which would usually have already I<skip>ped. If this happens,
735please report it as a bug, giving the OS and problem revision.
736
737=item *
738
739--early-fixup file
740
741=item *
742
743--late-fixup file
744
745Specify a file containing a patch or other fixup for the source code. The
746action to take depends on the first line of the fixup file
747
748=over 4
749
750=item *
751
752C<#!perl>
753
754If the first line starts C<#!perl> then the file is run using C<$^X>
755
756=item *
757
758C<#!/absolute/path>
759
760If a shebang line is present the file is executed using C<system>
761
762=item *
763
764C<I<filename> =~ /I<pattern>/>
765
766=item *
767
768C<I<filename> !~ /I<pattern>/>
769
770If I<filename> does not exist then the fixup file's contents are ignored.
771Otherwise, for C<=~>, if it contains a line matching I<pattern>, then the
772file is fed to C<patch -p1> on standard input. For C<=~>, the patch is
773applied if no lines match the pattern.
774
775As the empty pattern in Perl is a special case (it matches the most recent
776successful match) which is not useful here, the treatment of an empty pattern
777is special-cased. C<I<filename> =~ //> applies the patch if filename is
778present. C<I<filename> !~ //> applies the patch if filename missing. This
779makes it easy to unconditionally apply patches to files, and to use a patch
780as a way of creating a new file.
781
782=item *
783
784Otherwise, the file is assumed to be a patch, and always applied.
785
786=back
787
788I<early-fixup>s are applied before F<./Configure> is run. I<late-fixup>s are
789applied just after F<./Configure> is run.
790
791These options can be specified more than once. I<file> is actually expanded
792as a glob pattern. Globs that do not match are errors, as are missing files.
793
794=item *
795
796--no-clean
797
798Tell F<bisect-runner.pl> not to clean up after the build. This allows one
799to use F<bisect-runner.pl> to build the current particular perl revision for
800interactive testing, or for debugging F<bisect-runner.pl>.
801
802Passing this to F<bisect.pl> will likely cause the bisect to fail badly.
803
804=item *
805
806--validate
807
808Test that all stable (.0) revisions can be built. By default, attempts to
809build I<blead>, then tagged stable releases in reverse order down to
810I<perl-5.002> (or I<perl5.005> on a case insensitive file system). Stops at
811the first failure, without cleaning the checkout. Use I<--start> to specify
812the earliest revision to test, I<--end> to specify the most recent. Useful
813for validating a new OS/CPU/compiler combination. For example
814
815    ../perl/Porting/bisect.pl --validate -le 'print "Hello from $]"'
816
817If no testcase is specified, the default is to use F<t/TEST> to run
818F<t/base/*.t>
819
820=item *
821
822--check-args
823
824Validate the options and arguments, and exit silently if they are valid.
825
826=item *
827
828--check-shebang
829
830Validate that the test case isn't an executable file with a
831C<#!/usr/bin/perl> line (or similar). As F<bisect-runner.pl> does B<not>
832automatically prepend C<./perl> to the test case, a I<#!> line specifying an
833external F<perl> binary will cause the test case to always run with I<that>
834F<perl>, not the F<perl> built by the bisect runner. Likely this is not what
835you wanted. If your test case is actually a wrapper script to run other
836commands, you should run it with an explicit interpreter, to be clear. For
837example, instead of C<../perl/Porting/bisect.pl ~/test/testcase.pl> you'd
838run C<../perl/Porting/bisect.pl /usr/bin/perl ~/test/testcase.pl>
839
840=item *
841
842--gold
843
844Revision to use when checking out known-good recent versions of files,
845such as F<hints/freebsd.sh>. F<bisect-runner.pl> defaults this to I<blead>,
846but F<bisect.pl> will default it to the most recent stable release.
847
848=item *
849
850--usage
851
852=item *
853
854--help
855
856=item *
857
858-?
859
860Display the usage information and exit.
861
862=back
863
864=head1 ABOUT BISECTION
865
866The process is all about identifying the commit that caused some change
867in behaviour - maybe good, maybe bad. But it is built around C<git bisect>,
868which is much more specifically aimed at finding "what broke the build".
869C<git> terminology embeds that assumption - commits earlier than the
870target commit are "good" commits, those at or later than the target commit
871are "bad" commits.
872
873The default behaviour of F<bisect.pl> mimics this - you supply some code
874that I<fails> with a perl built B<at or after> the target commit and
875I<succeeds> with a perl built B<before> the target commit, and F<bisect.pl>
876will find the target commit.
877
878The F<bisect.pl> option C<--expect-fail> reverses those expectations
879(and changes nothing else). So with C<--expect-fail>, you should supply
880code that I<fails> only with a perl built B<before> the target commit,
881and I<succeeds> with a perl built B<at or after> the target commit.
882
883By default, I<failure> is a piece of perl code that terminates with
884a non-zero exit code, e.g. by calling C<die()>. Options that change what
885is interpreted as failure include C<--crash>, C<--test-build> and C<--match>.
886
887=head1 EXAMPLES
888
889=head2 Code has started to crash under C<miniperl>
890
891=over 4
892
893=item * Problem
894
895Under C<make minitest> (but not under C<make test_harness>), F<t/re/pat.t> was
896failing to compile.  What was the first commit at which that compilation
897failure could be observed?
898
899=item * Solution
900
901Extract code from the test file at the point where C<./miniperl -Ilib -c> was
902showing a compilation failure.  Use that in bisection with the C<miniperl>
903target.
904
905    .../Porting/bisect.pl --target=miniperl --start=2ec4590e \
906        -e 'q|ace| =~ /c(?=.$)/; $#{^CAPTURE} == -1); exit 0;'
907
908=item * Reference
909
910L<GH issue 17293|https://github.com/Perl/perl5/issues/17293>
911
912=back
913
914=head2 Blead breaks CPAN on threaded builds only
915
916=over 4
917
918=item * Problem
919
920Tests in CPAN module XML::Parser's test suite had begun to fail when tested
921against blead in threaded builds only.
922
923=item * Solution
924
925Provide F<Configure>-style switch to bisection program.  Straightforward use
926of the C<--module> switch.
927
928    .../Porting/bisect.pl -Duseithreads \
929        --start=6256cf2c \
930        --end=f6f85064 \
931        --module=XML::Parser
932
933=item * Reference
934
935L<GH issue 16918|https://github.com/Perl/perl5/issues/16918>
936
937=back
938
939=head2 Point in time where code started to segfault is unknown
940
941=over 4
942
943=item * Problem
944
945User submitted code sample which when run caused F<perl> to segfault, but did
946not claim that this was a recent change.
947
948=item * Solution
949
950Used locally installed production releases of perl (previously created by
951F<perlbrew>) to identify the first production release at which the code would
952not compile.  Used that information to shorten bisection time.
953
954    .../perl Porting/bisect.pl \
955        --start=v5.14.4 \
956        --end=v5.16.3 \
957        --crash -- ./perl -Ilib /tmp/gh-17333-map.pl
958
959    $ cat gh-17333-map.pl
960
961    @N = 1..5;
962    map { pop @N } @N;
963
964=item * Reference
965
966L<GH issue 17333|https://github.com/Perl/perl5/issues/17333>
967
968=back
969
970=head2 Interaction of debug flags caused crash on C<-DDEBUGGING> builds
971
972=over 4
973
974=item * Problem
975
976In C<-DDEBUGGING> builds, the debug flags C<Xvt> would crash a program when
977F<strict.pm> was loaded via C<require> or C<use>.
978
979=item * Solution
980
981Two-stage solution.  In each stage, to shorten debugging time investigator
982made use of existing set of production releases of F<perl> built with
983C<-DDEBUGGING>.
984
985=over 4
986
987=item * Stage 1
988
989Investigator used existing C<-DDEBUGGING> builds to determine the production
990cycle in which crash first appeared.  Then:
991
992    .../perl/Porting/bisect.pl \
993        --start v5.20.0 \
994        --end v5.22.1 \
995        -DDEBUGGING \
996        --target miniperl \
997        --crash \
998        -- ./miniperl -Ilib -DXvt -Mstrict -e 1
999
1000First bad commit was identified as
1001L<ed958fa315|https://github.com/Perl/perl5/commit/ed958fa315>.
1002
1003=item * Stage 2
1004
1005A second investigator was able to create a reduction of the code needed to
1006trigger a crash, then used this reduced case and the commit reported at the
1007end of Stage 1 to further bisect.
1008
1009 .../perl/Porting/bisect.pl \
1010   --start v5.18.4 \
1011   --end ed958fa315 \
1012   -DDEBUGGING \
1013   --target miniperl \
1014   --crash \
1015   -- ./miniperl -Ilib -DXv -e '{ my $n=1; *foo= sub () { $n }; }'
1016
1017=back
1018
1019The first bisect determined the point at which code was introduced to
1020F<strict.pm> that triggered the problem. With an understanding of the trigger,
1021the second bisect then determined the point at which such a trigger started
1022causing a crash.
1023
1024* Reference
1025
1026L<GH issue 193463|https://github.com/Perl/perl5/issues/19463>
1027
1028=back
1029
1030=head2 When did perl start failing to build on a certain platform using C<g++> as the C-compiler?
1031
1032=over 4
1033
1034=item * Problem
1035
1036On NetBSD-8.0, C<perl> had never been smoke-tested using C<g++> as the
1037C-compiler.  Once this was done, it became evident that changes in that
1038version of the operating system's code were incompatible with some C<perl>
1039source written long before that OS version was ever released!
1040
1041=item * Solution
1042
1043Bisection range was first narrowed using existing builds at release tags.
1044Then, bisection specified the C-compiler via C<Configure>-style switch and
1045used C<--test-build> to identify the commit which "broke" the build.
1046
1047    .../perl Porting/bisect.pl \
1048        -Dcc=g++ \
1049        --test-build \
1050        --start=v5.21.6 \
1051        --end=v5.21.7
1052
1053Then, problem was discussed with knowledgeable NetBSD user.
1054
1055=item * Reference
1056
1057L<GH issue 17381|https://github.com/Perl/perl5/issues/17381>
1058
1059=back
1060
1061=head2 When did a test file start to emit warnings?
1062
1063=over 4
1064
1065=item * Problem
1066
1067When F<dist/Tie-File/t/43_synopsis> was run as part of C<make test>, we
1068observed warnings not previously seen.  At what commit were those warnings
1069first emitted?
1070
1071=item * Solution
1072
1073We know that when this test file was first committed to blead, no warnings
1074were observed and there was no output to C<STDERR>.  So that commit becomes
1075the value for C<--start>.
1076
1077Since the test file in question is for a CPAN distribution maintained by core,
1078we must prepare to run that test by including C<--target=test_prep> in the
1079bisection invocation.  We then run the test file in a way that captures
1080C<STDERR> in a file.  If that file has non-zero size, then we have presumably
1081captured the newly seen warnings.
1082
1083    export ERR="/tmp/err"
1084
1085    .../perl Porting/bisect.pl \
1086      --start=507614678018ae1abd55a22e9941778c65741ba3 \
1087      --end=d34b46d077dcfc479c36f65b196086abd7941c76 \
1088      --target=test_prep \
1089      -e 'chdir("t");
1090        system(
1091          "./perl harness ../dist/Tie-File/t/43_synopsis.t
1092            2>$ENV{ERR}"
1093        );
1094        -s $ENV{ERR} and die "See $ENV{ERR} for warnings thrown";'
1095
1096Bisection pointed to a commit where strictures and warnings were first turned
1097on throughout the F<dist/Tie-File/> directory.
1098
1099=item * Reference
1100
1101L<Commit 125e1a3|https://github.com/Perl/perl5/commit/125e1a36a939>
1102
1103=back
1104
1105=head2 When did a one-liner start to emit warnings?
1106
1107=over 4
1108
1109=item * Problem
1110
1111In L<GH issue 21555|https://github.com/Perl/perl5/issues/21555>, it was
1112reported that the following one-liner was not emitting warnings in perl-5.16
1113but was in perl-5.26 and later releases.
1114
1115    perl -we '"ab" =~ /.{-1,4}/;'
1116
1117The reporter's concern was the negative repeat in this (generated) regular
1118expression.  The warning being emitted was:
1119
1120    Unescaped left brace in regex is passed through in regex;
1121      marked by <-- HERE in m/.{ <-- HERE -1,4}/ at -e line 1.
1122
1123At what commit was that warning first emitted?
1124
1125=item * Solution
1126
1127We used F<perlbrew> to narrow down the range needing testing to the 5.25
1128development cycle.  We then bisected with the C<--one-liner> switch and the
1129following invocation:
1130
1131    export ERR=/tmp/err; rm $ERR
1132
1133    perl Porting/bisect.pl \
1134      --start=v5.24.0 \
1135      --end=v5.26.0 \
1136      --one-liner 'system(qq|./perl -we "q{ab} =~ /.{-1,4}/" 2>$ENV{ERR}|);
1137                  die "See $ENV{ERR} for warnings thrown" if -s $ENV{ERR};'
1138
1139Bisection pointed to a commit where a modification had been made to a warning.
1140
1141=item * Reference
1142
1143L<Commit 8e84dec|https://github.com/Perl/perl5/commit/8e84dec289>
1144
1145=back
1146
1147=head2 When did perl stop segfaulting on certain code?
1148
1149=over 4
1150
1151=item * Problem
1152
1153It was reported that perl was segfaulting on this code in perl-5.36.0:
1154
1155    @a = sort{eval"("}1,2
1156
1157Bisection subsequently identified the commit at which the segfaulting first
1158appeared.  But when we ran that code against what was then the HEAD of blead
1159(L<Commit 70d911|https://github.com/Perl/perl5/commit/70d911984f>), we got no
1160segfault.  So the next question we faced was: At what commit did the
1161segfaulting cease?
1162
1163=item * Solution
1164
1165Because the code in question loaded no libraries, it was amenable to bisection
1166with C<miniperl>, thereby shortening bisection time considerably.
1167
1168    perl Porting/bisect.pl \
1169        --start=v5.36.0 \
1170        --target=miniperl \
1171        --expect-fail -e '@a = sort{eval"("}1,2'
1172
1173=item * Reference
1174
1175L<GH issue 20261|https://github.com/Perl/perl5/issues/20261>
1176
1177=back
1178
1179=head2 When did perl stop emitting warnings when running on certain code?
1180
1181=over 4
1182
1183=item * Background
1184
1185Most of the time, we bisect in order to identify the first "bad" commit:  the
1186first time code failed to compile; the first time the code emitted warnings;
1187and so forth.
1188
1189Some times, however, we want to identify the first "good" commit:  the point
1190where the code began to compile; the point where the code no longer emitted
1191warnings; etc.
1192
1193We can use this program for that purpose, but we have to reverse our sense of
1194"good" and "bad" commits.  We use the C<--expect-fail> option to do that
1195reversal.
1196
1197=item * Problem
1198
1199It was reported that in an older version of Perl, a warning was being emitted
1200when a program was using the F<bigrat> module and
1201C<Scalar::Util::looks_like_number()> was called passing a non-integral number
1202(I<i.e.,> a rational).
1203
1204    $ perl -wE 'use Scalar::Util; use bigrat;
1205      say "mercy" if Scalar::Util::looks_like_number(1/9);'
1206
1207In perl-5.32, this emitted:
1208
1209    $ Argument "1/9" isn't numeric in addition (+) at
1210      /usr/local/lib/perl5/5.32/Math/BigRat.pm line 1955.
1211      mercy
1212
1213But it was observed that there was no warning in perl-5.36.
1214
1215=item * Solution
1216
1217    $ perl Porting/bisect.pl \
1218        --start=5624cfff8f \
1219        --end=b80b9f7fc6 \
1220        --expect-fail \
1221        -we 'use Scalar::Util; use bigrat; my @w;
1222            local $SIG{__WARN__} = sub { die };
1223            print "mercy\n" if Scalar::Util::looks_like_number(1/9)'
1224
1225=item * Reference
1226
1227L<GH issue 20685|https://github.com/Perl/perl5/issues/20685>
1228
1229=item * Problem
1230
1231An issue was identified during use of the Perl debugger, but soon a change in
1232C-level code became suspected.  Identifying the breaking commit entailed
1233writing a Perl program which used a dummy C<Devel::*> module.
1234
1235=item * Solution
1236
1237=over 4
1238
1239=item *
1240
1241Create this file:
1242
1243    $ cat /tmp/21564.pl
1244    #!/usr/bin/perl
1245
1246    use strict; no strict 'refs';
1247    use warnings;
1248    use B qw(svref_2object SVf_IOK);
1249
1250    use v5.10;
1251
1252    my $b = svref_2object(\(${"_</tmp/21564b.pl"}[4]));
1253    unless ($b->FLAGS & SVf_IOK) {
1254      die "Fail!";
1255    }
1256    say "Ok";
1257
1258=item *
1259
1260Bisect with an invocation which calls a `perl` debugger program.
1261
1262    $ PERL5DB='sub DB::DB {}' perl Porting/bisect.pl \
1263      --start=v5.35.5 \
1264      --end=v5.35.6 \
1265      -- ./perl -Ilib -d /tmp/21564b.pl
1266
1267=back
1268
1269=item * Reference
1270
1271L<GH issue 21564|https://github.com/Perl/perl5/issues/21564>
1272
1273=back
1274
1275=cut
1276
1277# Ensure we always exit with 255, to cause git bisect to abort.
1278sub croak_255 {
1279    my $message = join '', @_;
1280    if ($message =~ /\n\z/) {
1281        print STDERR $message;
1282    } else {
1283        my (undef, $file, $line) = caller 1;
1284        print STDERR "@_ at $file line $line\n";
1285    }
1286    exit 255;
1287}
1288
1289sub die_255 {
1290    croak_255(@_);
1291}
1292
1293die_255("$0: Can't build $target")
1294    if defined $target && !grep {@targets} $target;
1295
1296foreach my $phase (qw(early late)) {
1297    next unless $options{"$phase-fixup"};
1298    my $bail_out;
1299    require File::Glob;
1300    my @expanded;
1301    foreach my $glob (@{$options{"$phase-fixup"}}) {
1302        my @got = File::Glob::bsd_glob($glob);
1303        push @expanded, @got ? @got : $glob;
1304    }
1305    @expanded = sort @expanded;
1306    $options{"$phase-fixup"} = \@expanded;
1307    foreach (@expanded) {
1308        unless (-f $_) {
1309            print STDERR "$phase-fixup '$_' is not a readable file\n";
1310            ++$bail_out;
1311        }
1312    }
1313    exit 255 if $bail_out;
1314}
1315
1316unless (exists $defines{cc}) {
1317    # If it fails, the heuristic of 63f9ec3008baf7d6 is noisy, and hence
1318    # confusing.
1319    # FIXME - really it should be replaced with a proper test of
1320    # "can we build something?" and a helpful diagnostic if we can't.
1321    # For now, simply move it here.
1322    $defines{cc} = (`ccache -V`, $?) ? 'cc' : 'ccache cc';
1323}
1324
1325my $j = $options{jobs} ? "-j$options{jobs}" : '';
1326
1327if (exists $options{make}) {
1328    if (!exists $defines{make}) {
1329        $defines{make} = $options{make};
1330    }
1331} else {
1332    $options{make} = 'make';
1333}
1334
1335# Sadly, however hard we try, I don't think that it will be possible to build
1336# modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29,
1337# which updated to MakeMaker 3.7, which changed from using a hard coded ld
1338# in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc.
1339
1340sub open_or_die {
1341    my $file = shift;
1342    my $mode = @_ ? shift : '<';
1343    open my $fh, $mode, $file or croak_255("Can't open $file: $!");
1344    ${*$fh{SCALAR}} = $file;
1345    return $fh;
1346}
1347
1348sub close_or_die {
1349    my $fh = shift;
1350    return if close $fh;
1351    croak_255("Can't close: $!") unless ref $fh eq 'GLOB';
1352    croak_255("Can't close ${*$fh{SCALAR}}: $!");
1353}
1354
1355sub system_or_die {
1356    my $command = '</dev/null ' . shift;
1357    system($command) and croak_255("'$command' failed, \$!=$!, \$?=$?");
1358}
1359
1360sub run_with_options {
1361    my $options = shift;
1362    my $name = $options->{name};
1363    $name = "@_" unless defined $name;
1364
1365    my $setgrp = $options->{setpgrp};
1366    if ($options->{timeout}) {
1367        # Unless you explicitly disabled it on the commandline, set it:
1368        $setgrp = 1 unless defined $setgrp;
1369    }
1370    my $pid = fork;
1371    die_255("Can't fork: $!") unless defined $pid;
1372    if (!$pid) {
1373        if (exists $options->{stdin}) {
1374            open STDIN, '<', $options->{stdin}
1375              or die "Can't open STDIN from $options->{stdin}: $!";
1376        }
1377        if ($setgrp) {
1378            setpgrp 0, 0
1379                or die "Can't setpgrp 0, 0: $!";
1380        }
1381        { exec @_ };
1382        die_255("Failed to start $name: $!");
1383    }
1384    my $start;
1385    if ($options->{timeout}) {
1386        require Errno;
1387        require POSIX;
1388        die_255("No POSIX::WNOHANG")
1389            unless &POSIX::WNOHANG;
1390        $start = time;
1391        $SIG{ALRM} = sub {
1392            my $victim = $setgrp ? -$pid : $pid;
1393            my $delay = 1;
1394            kill 'TERM', $victim;
1395            waitpid(-1, &POSIX::WNOHANG);
1396            while (kill 0, $victim) {
1397                sleep $delay;
1398                waitpid(-1, &POSIX::WNOHANG);
1399                $delay *= 2;
1400                if ($delay > 8) {
1401                    if (kill 'KILL', $victim) {
1402                        print STDERR "$0: Had to kill 'KILL', $victim\n"
1403                    } elsif (! $!{ESRCH}) {
1404                        print STDERR "$0: kill 'KILL', $victim failed: $!\n";
1405                    }
1406                    last;
1407                }
1408            }
1409            report_and_exit(0, 'No timeout', 'Timeout', "when running $name");
1410        };
1411        alarm $options->{timeout};
1412    }
1413    waitpid $pid, 0
1414      or die_255("wait for $name, pid $pid failed: $!");
1415    alarm 0;
1416    if ($options->{timeout}) {
1417        my $elapsed = time - $start;
1418        if ($elapsed / $options->{timeout} > 0.8) {
1419            print STDERR "$0: Beware, took $elapsed seconds of $options->{timeout} permitted to run $name\n";
1420        }
1421    }
1422    return $?;
1423}
1424
1425sub extract_from_file {
1426    my ($file, $rx, $default) = @_;
1427    my $fh = open_or_die($file);
1428    while (<$fh>) {
1429	my @got = $_ =~ $rx;
1430	return wantarray ? @got : $got[0]
1431	    if @got;
1432    }
1433    return $default if defined $default;
1434    return;
1435}
1436
1437sub edit_file {
1438    my ($file, $munger) = @_;
1439    my $fh = open_or_die($file);
1440    my $orig = do {
1441        local $/;
1442        <$fh>;
1443    };
1444    die_255("Can't read $file: $!") unless defined $orig && close $fh;
1445    my $new = $munger->($orig);
1446    return if $new eq $orig;
1447    $fh = open_or_die($file, '>');
1448    print $fh $new or die_255("Can't print to $file: $!");
1449    close_or_die($fh);
1450}
1451
1452# AIX supplies a pre-historic patch program, which certainly predates Linux
1453# and is probably older than NT. It can't cope with unified diffs. Meanwhile,
1454# it's hard enough to get git diff to output context diffs, let alone git show,
1455# and nearly all the patches embedded here are unified. So it seems that the
1456# path of least resistance is to convert unified diffs to context diffs:
1457
1458sub process_hunk {
1459    my ($from_out, $to_out, $has_from, $has_to, $delete, $add) = @_;
1460    ++$$has_from if $delete;
1461    ++$$has_to if $add;
1462
1463    if ($delete && $add) {
1464        $$from_out .= "! $_\n" foreach @$delete;
1465        $$to_out .= "! $_\n" foreach @$add;
1466    } elsif ($delete) {
1467        $$from_out .= "- $_\n" foreach @$delete;
1468    } elsif ($add) {
1469         $$to_out .= "+ $_\n" foreach @$add;
1470    }
1471}
1472
1473# This isn't quite general purpose, as it can't cope with
1474# '\ No newline at end of file'
1475sub ud2cd {
1476    my $diff_in = shift;
1477    my $diff_out = '';
1478
1479    # Stuff before the diff
1480    while ($diff_in =~ s/\A(?!\*\*\* )(?!--- )([^\n]*\n?)//ms && length $1) {
1481        $diff_out .= $1;
1482    }
1483
1484    if (!length $diff_in) {
1485        die_255("That didn't seem to be a diff");
1486    }
1487
1488    if ($diff_in =~ /\A\*\*\* /ms) {
1489        warn "Seems to be a context diff already\n";
1490        return $diff_out . $diff_in;
1491    }
1492
1493    # Loop for files
1494 FILE: while (1) {
1495        if ($diff_in =~ s/\A((?:diff |index )[^\n]+\n)//ms) {
1496            $diff_out .= $1;
1497            next;
1498        }
1499        if ($diff_in !~ /\A--- /ms) {
1500            # Stuff after the diff;
1501            return $diff_out . $diff_in;
1502        }
1503        $diff_in =~ s/\A([^\n]+\n?)//ms;
1504        my $line = $1;
1505        die_255("Can't parse '$line'") unless $line =~ s/\A--- /*** /ms;
1506        $diff_out .= $line;
1507        $diff_in =~ s/\A([^\n]+\n?)//ms;
1508        $line = $1;
1509        die_255("Can't parse '$line'") unless $line =~ s/\A\+\+\+ /--- /ms;
1510        $diff_out .= $line;
1511
1512        # Loop for hunks
1513        while (1) {
1514            next FILE
1515                unless $diff_in =~ s/\A\@\@ (-([0-9]+),([0-9]+) \+([0-9]+),([0-9]+)) \@\@[^\n]*\n?//;
1516            my ($hunk, $from_start, $from_count, $to_start, $to_count)
1517                = ($1, $2, $3, $4, $5);
1518            my $from_end = $from_start + $from_count - 1;
1519            my $to_end = $to_start + $to_count - 1;
1520            my ($from_out, $to_out, $has_from, $has_to, $add, $delete);
1521            while (length $diff_in && ($from_count || $to_count)) {
1522                die_255("Confused in $hunk")
1523                    unless $diff_in =~ s/\A([^\n]*)\n//ms;
1524                my $line = $1;
1525                $line = ' ' unless length $line;
1526                if ($line =~ /^ .*/) {
1527                    process_hunk(\$from_out, \$to_out, \$has_from, \$has_to,
1528                                 $delete, $add);
1529                    undef $delete;
1530                    undef $add;
1531                    $from_out .= " $line\n";
1532                    $to_out .= " $line\n";
1533                    --$from_count;
1534                    --$to_count;
1535                } elsif ($line =~ /^-(.*)/) {
1536                    push @$delete, $1;
1537                    --$from_count;
1538                } elsif ($line =~ /^\+(.*)/) {
1539                    push @$add, $1;
1540                    --$to_count;
1541                } else {
1542                    die_255("Can't parse '$line' as part of hunk $hunk");
1543                }
1544            }
1545            process_hunk(\$from_out, \$to_out, \$has_from, \$has_to,
1546                         $delete, $add);
1547            die_255("No lines in hunk $hunk")
1548                unless length $from_out || length $to_out;
1549            die_255("No changes in hunk $hunk")
1550                unless $has_from || $has_to;
1551            $diff_out .= "***************\n";
1552            $diff_out .= "*** $from_start,$from_end ****\n";
1553            $diff_out .= $from_out if $has_from;
1554            $diff_out .= "--- $to_start,$to_end ----\n";
1555            $diff_out .= $to_out if $has_to;
1556        }
1557    }
1558}
1559
1560{
1561    my $use_context;
1562
1563    sub placate_patch_prog {
1564        my $patch = shift;
1565
1566        if (!defined $use_context) {
1567            my $version = `patch -v 2>&1`;
1568            die_255("Can't run `patch -v`, \$?=$?, bailing out")
1569                unless defined $version;
1570            if ($version =~ /Free Software Foundation/) {
1571                $use_context = 0;
1572            } elsif ($version =~ /Header: patch\.c,v.*\blwall\b/) {
1573                # The system patch is older than Linux, and probably older than
1574                # Windows NT.
1575                $use_context = 1;
1576            } elsif ($version =~ /Header: patch\.c,v.*\babhinav\b/) {
1577                # Thank you HP. No, we have no idea *which* version this is:
1578                # $Header: patch.c,v 76.1.1.2.1.3 2001/12/03 12:24:52 abhinav Exp $
1579                $use_context = 1;
1580            } else {
1581                # Don't know.
1582                $use_context = 0;
1583            }
1584        }
1585
1586        return $use_context ? ud2cd($patch) : $patch;
1587    }
1588}
1589
1590sub apply_patch {
1591    my ($patch, $what, $files) = @_;
1592    $what = 'patch' unless defined $what;
1593    unless (defined $files) {
1594        # Handle context diffs (*** ---) and unified diffs (+++ ---)
1595        # and ignore trailing "garbage" after the filenames
1596        $patch =~ m!^[-*]{3} [ab]/(\S+)[^\n]*\n[-+]{3} [ba]/\1!sm;
1597        $files = " $1";
1598    }
1599    my $patch_to_use = placate_patch_prog($patch);
1600    open my $fh, '|-', 'patch', '-p1' or die_255("Can't run patch: $!");
1601    print $fh $patch_to_use;
1602    return if close $fh;
1603    print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n";
1604    print STDERR "\nConverted to a context diff <<'EOCONTEXT'\n${patch_to_use}EOCONTEXT\n"
1605        if $patch_to_use ne $patch;
1606    die_255("Can't $what$files: $?, $!");
1607}
1608
1609sub patch_from_commit {
1610    my ($revert, $commit, @files) = @_;
1611    my $flags = $revert ? '-R ' : '';
1612    my $patch = `git show --src-prefix=a/ --dst-prefix=b/ $flags$commit @files`;
1613    if (!defined $patch) {
1614        my $thing = $revert ? 'revert commit' : 'commit';
1615        die_255("Can't get $thing $commit for @files: $?") if @files;
1616        die_255("Can't get $thing $commit: $?");
1617    }
1618    return $patch;
1619}
1620
1621sub apply_commit {
1622    my ($commit, @files) = @_;
1623    my $patch = patch_from_commit(undef, $commit, @files);
1624    apply_patch($patch, "patch $commit", @files ? " for @files" : '');
1625}
1626
1627sub revert_commit {
1628    my ($commit, @files) = @_;
1629    my $patch = patch_from_commit('revert', $commit, @files);
1630    apply_patch($patch, "revert $commit", @files ? " for @files" : '');
1631}
1632
1633sub checkout_file {
1634    my ($file, $commit) = @_;
1635    $commit ||= $options{gold} || 'blead';
1636    system "git show $commit:$file > $file </dev/null"
1637        and die_255("Could not extract $file at revision $commit");
1638}
1639
1640sub check_shebang {
1641    my $file = shift;
1642    return unless -e $file;
1643    my $fh = open_or_die($file);
1644    my $line = <$fh>;
1645    return if $line =~ $run_with_our_perl;
1646    if (!-x $file) {
1647        die_255("$file is not executable.
1648system($file, ...) is always going to fail.
1649
1650Bailing out");
1651    }
1652    return unless $line =~ m{\A#!(/\S+/perl\S*)\s};
1653    die_255("$file will always be run by $1
1654It won't be tested by the ./perl we build.
1655If you intended to run it with that perl binary, please change your
1656test case to
1657
1658    $1 @ARGV
1659
1660If you intended to test it with the ./perl we build, please change your
1661test case to
1662
1663    ./perl -Ilib @ARGV
1664
1665[You may also need to add -- before ./perl to prevent that -Ilib as being
1666parsed as an argument to bisect.pl]
1667
1668Bailing out");
1669}
1670
1671sub clean {
1672    if ($options{clean}) {
1673        # Needed, because files that are build products in this checked out
1674        # version might be in git in the next desired version.
1675        system 'git clean -qdxf </dev/null';
1676        # Needed, because at some revisions the build alters checked out files.
1677        # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
1678        system 'git reset --hard HEAD </dev/null';
1679    }
1680}
1681
1682sub skip {
1683    my $reason = shift;
1684    clean();
1685    warn "skipping - $reason";
1686    exit 125;
1687}
1688
1689sub report_and_exit {
1690    my ($good, $pass, $fail, $desc) = @_;
1691
1692    clean();
1693
1694    my $got = ($options{'expect-pass'} ? $good : !$good) ? 'good' : 'bad';
1695    if ($good) {
1696        print "$got - $pass $desc\n";
1697    } else {
1698        print "$got - $fail $desc\n";
1699    }
1700
1701    exit($got eq 'bad');
1702}
1703
1704sub run_report_and_exit {
1705    my $ret = run_with_options({setprgp => $options{setpgrp},
1706                                timeout => $options{timeout},
1707                               }, @_);
1708    $ret &= 0xff if $options{crash};
1709    report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_");
1710}
1711
1712sub match_and_exit {
1713    my ($target, @globs) = @_;
1714    my $matches = 0;
1715    my $re = qr/$match/;
1716    my @files;
1717
1718    if (@globs) {
1719        require File::Glob;
1720        foreach (sort map { File::Glob::bsd_glob($_)} @globs) {
1721            if (!-f $_ || !-r _) {
1722                warn "Skipping matching '$_' as it is not a readable file\n";
1723            } else {
1724                push @files, $_;
1725            }
1726        }
1727    } else {
1728        local $/ = "\0";
1729        @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`;
1730        chomp @files;
1731    }
1732
1733    foreach my $file (@files) {
1734        my $fh = open_or_die($file);
1735        while (<$fh>) {
1736            if ($_ =~ $re) {
1737                ++$matches;
1738                if (/[^[:^cntrl:]\h\v]/) { # Matches non-spacing non-C1 controls
1739                    print "Binary file $file matches\n";
1740                } else {
1741                    $_ .= "\n" unless /\n\z/;
1742                    print "$file: $_";
1743                }
1744            }
1745        }
1746        close_or_die($fh);
1747    }
1748    report_and_exit($matches,
1749                    $matches == 1 ? '1 match for' : "$matches matches for",
1750                    'no matches for', $match);
1751}
1752
1753# Not going to assume that system perl is yet new enough to have autodie
1754system_or_die('git clean -dxf');
1755
1756if (!defined $target) {
1757    match_and_exit(undef, @ARGV) if $match;
1758    $target = 'test_prep';
1759} elsif ($target eq 'none') {
1760    match_and_exit(undef, @ARGV) if $match;
1761    run_report_and_exit(@ARGV);
1762}
1763
1764skip('no Configure - is this the //depot/perlext/Compiler branch?')
1765    unless -f 'Configure';
1766
1767my $case_insensitive;
1768{
1769    my ($dev_C, $ino_C) = stat 'Configure';
1770    die_255("Could not stat Configure: $!") unless defined $dev_C;
1771    my ($dev_c, $ino_c) = stat 'configure';
1772    ++$case_insensitive
1773        if defined $dev_c && $dev_C == $dev_c && $ino_C == $ino_c;
1774}
1775
1776# This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
1777my $major
1778    = extract_from_file('patchlevel.h',
1779			qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
1780			0);
1781
1782my $unfixable_db_file;
1783
1784if ($major < 10
1785    && !extract_from_file('ext/DB_File/DB_File.xs',
1786                          qr!^#else /\* Berkeley DB Version > 2 \*/$!)) {
1787    # This DB_File.xs is really too old to patch up.
1788    # Skip DB_File, unless we're invoked with an explicit -Unoextensions
1789    if (!exists $defines{noextensions}) {
1790        $defines{noextensions} = 'DB_File';
1791    } elsif (defined $defines{noextensions}) {
1792        $defines{noextensions} .= ' DB_File';
1793    }
1794    ++$unfixable_db_file;
1795}
1796
1797patch_Configure();
1798patch_hints();
1799if ($options{'all-fixups'}) {
1800    patch_SH();
1801    patch_C();
1802    patch_ext();
1803    patch_t();
1804}
1805apply_fixups($options{'early-fixup'});
1806
1807# if Encode is not needed for the test, you can speed up the bisect by
1808# excluding it from the runs with -Dnoextensions=Encode
1809# ccache is an easy win. Remove it if it causes problems.
1810# Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
1811# to true in hints/linux.sh
1812# On dromedary, from that point on, Configure (by default) fails to find any
1813# libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
1814# versioned libraries. Without -lm, the build fails.
1815# Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
1816# until commit faae14e6e968e1c0 adds it to the hints.
1817# However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
1818# because it will spot versioned libraries, pass them to the compiler, and then
1819# bail out pretty early on. Configure won't let us override libswanted, but it
1820# will let us override the entire libs list.
1821
1822foreach (@{$options{A}}) {
1823    push @paths, $1 if /^libpth=(.*)/s;
1824}
1825
1826unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
1827    # Before 1cfa4ec74d4933da, so force the libs list.
1828
1829    my @libs;
1830    # This is the current libswanted list from Configure, less the libs removed
1831    # by current hints/linux.sh
1832    foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl
1833			ld sun m crypt sec util c cposix posix ucb BSD)) {
1834	foreach my $dir (@paths) {
1835            # Note the wonderful consistency of dot-or-not in the config vars:
1836            next unless -f "$dir/lib$lib.$Config{dlext}"
1837                || -f "$dir/lib$lib$Config{lib_ext}";
1838	    push @libs, "-l$lib";
1839	    last;
1840	}
1841    }
1842    $defines{libs} = \@libs unless exists $defines{libs};
1843}
1844
1845# a4f3eea9be6bcf3c added a test for GNU libc to Configure
1846# Prior to that we really don't get much choice but to force usenm off
1847# everywhere (and modern systems are fast enough that this doesn't matter)
1848$defines{usenm} = undef
1849    if $major < 4 && !exists $defines{usenm};
1850
1851my ($missing, $created_dirs);
1852($missing, $created_dirs) = force_manifest()
1853    if $options{'force-manifest'};
1854
1855my @ARGS = '-dEs';
1856foreach my $key (sort keys %defines) {
1857    my $val = $defines{$key};
1858    if (ref $val) {
1859        push @ARGS, "-D$key=@$val";
1860    } elsif (!defined $val) {
1861        push @ARGS, "-U$key";
1862    } elsif (!length $val) {
1863        push @ARGS, "-D$key";
1864    } else {
1865        $val = "" if $val eq "\0";
1866        push @ARGS, "-D$key=$val";
1867    }
1868}
1869push @ARGS, map {"-A$_"} @{$options{A}};
1870
1871my $prefix;
1872
1873# Testing a module? We need to install perl/cpan modules to a temp dir
1874if ($options{module} || $options{'with-module'} || $options{'test-module'})
1875{
1876  $prefix = tempdir(CLEANUP => 1);
1877
1878  push @ARGS, "-Dprefix=$prefix";
1879  push @ARGS, "-Uversiononly", "-Dinstallusrbinperl=n";
1880}
1881
1882# If a file in MANIFEST is missing, Configure asks if you want to
1883# continue (the default being 'n'). With stdin closed or /dev/null,
1884# it exits immediately and the check for config.sh below will skip.
1885# Without redirecting stdin, the commands called will attempt to read from
1886# stdin (and thus effectively hang)
1887run_with_options({stdin => '/dev/null', name => 'Configure'},
1888                 './Configure', @ARGS);
1889
1890patch_SH() unless $options{'all-fixups'};
1891apply_fixups($options{'late-fixup'});
1892
1893if (-f 'config.sh') {
1894    # Emulate noextensions if Configure doesn't support it.
1895    fake_noextensions()
1896        if $major < 10 && $defines{noextensions};
1897    if (system './Configure -S') {
1898        # See commit v5.23.5-89-g7a4fcb3.  Configure may try to run
1899        # ./optdef.sh instead of UU/optdef.sh.  Copying the file is
1900        # easier than patching Configure (which mentions optdef.sh multi-
1901        # ple times).
1902        require File::Copy;
1903        File::Copy::copy("UU/optdef.sh", "./optdef.sh");
1904        system_or_die('./Configure -S');
1905    }
1906}
1907
1908if ($target =~ /config\.s?h/) {
1909    match_and_exit($target, @ARGV) if $match && -f $target;
1910    report_and_exit(-f $target, 'could build', 'could not build', $target)
1911        if $options{'test-build'};
1912
1913    skip("could not build $target") unless -f $target;
1914
1915    run_report_and_exit(@ARGV);
1916} elsif (!-f 'config.sh') {
1917    report_and_exit(undef, 'PLEASE REPORT BUG', 'could not build', 'config.sh')
1918        if $options{'test-build'};
1919
1920    # Skip if something went wrong with Configure
1921    skip('could not build config.sh');
1922}
1923
1924force_manifest_cleanup($missing, $created_dirs)
1925        if $missing;
1926
1927if($options{'force-regen'}
1928   && extract_from_file('Makefile', qr/\bregen_headers\b/)) {
1929    # regen_headers was added in e50aee73b3d4c555, patch.1m for perl5.001
1930    # It's not worth faking it for earlier revisions.
1931    system_or_die('make regen_headers');
1932}
1933
1934unless ($options{'all-fixups'}) {
1935    patch_C();
1936    patch_ext();
1937    patch_t();
1938}
1939
1940# Parallel build for miniperl is safe
1941system "$options{make} $j miniperl </dev/null";
1942
1943# This is the file we expect make to create
1944my $expected_file = $target =~ /^test/ ? 't/perl'
1945    : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}"
1946    : $target;
1947# This is the target we tell make to build in order to get $expected_file
1948my $real_target = $target eq 'Fcntl' ? $expected_file : $target;
1949
1950if ($target ne 'miniperl') {
1951    # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
1952    $j = '' if $major < 10;
1953
1954    if ($real_target eq 'test_prep') {
1955        if ($major < 8) {
1956            # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
1957            # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
1958            # earlier than that, just make test. It will be fast enough.
1959            $real_target = extract_from_file('Makefile.SH',
1960                                             qr/^(test[-_]prep):/,
1961                                             'test');
1962        }
1963    }
1964
1965    system "$options{make} $j $real_target </dev/null";
1966}
1967
1968my $expected_file_found = $expected_file =~ /perl$/
1969    ? -x $expected_file : -r $expected_file;
1970
1971if ($expected_file_found && $expected_file eq 't/perl') {
1972    # Check that it isn't actually pointing to ../miniperl, which will happen
1973    # if the sanity check ./miniperl -Ilib -MExporter -e '<?>' fails, and
1974    # Makefile tries to run minitest.
1975
1976    # Of course, helpfully sometimes it's called ../perl, other times .././perl
1977    # and who knows if that list is exhaustive...
1978    my ($dev0, $ino0) = stat 't/perl';
1979    my ($dev1, $ino1) = stat 'perl';
1980    unless (defined $dev0 && defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1) {
1981        undef $expected_file_found;
1982        my $link = readlink $expected_file;
1983        warn "'t/perl' => '$link', not 'perl'";
1984        die_255("Could not realink t/perl: $!") unless defined $link;
1985    }
1986}
1987
1988my $just_testing = 0;
1989
1990if ($options{'test-build'}) {
1991    report_and_exit($expected_file_found, 'could build', 'could not build',
1992                    $real_target);
1993} elsif (!$expected_file_found) {
1994    skip("could not build $real_target");
1995} elsif (my $mod_opt = $options{module} || $options{'with-module'}
1996               || ($just_testing++, $options{'test-module'})) {
1997  # Testing a cpan module? See if it will install
1998  # First we need to install this perl somewhere
1999  system_or_die('./installperl');
2000
2001  my @m = split(',', $mod_opt);
2002
2003  my $bdir = File::Temp::tempdir(
2004    CLEANUP => 1,
2005  ) or die $!;
2006
2007  # Don't ever stop to ask the user for input
2008  $ENV{AUTOMATED_TESTING} = 1;
2009  $ENV{PERL_MM_USE_DEFAULT} = 1;
2010
2011  # Don't let these interfere with our cpan installs
2012  delete $ENV{PERL_MB_OPT};
2013  delete $ENV{PERL_MM_OPT};
2014
2015  # Make sure we load up our CPAN::MyConfig and then
2016  # override the build_dir so we have a fresh one
2017  # every build
2018  my $cdir = $options{'cpan-config-dir'}
2019          || File::Spec->catfile($ENV{HOME},".cpan");
2020
2021  my @cpanshell = (
2022    "$prefix/bin/perl",
2023    "-I", "$cdir",
2024    "-MCPAN::MyConfig",
2025    "-MCPAN",
2026    "-e","\$CPAN::Config->{build_dir}=q{$bdir};",
2027    "-e",
2028  );
2029
2030  for (@m) {
2031    s/-/::/g if /-/ and !m|/|;
2032  }
2033  my $install = join ",", map { "'$_'" } @m;
2034  if ($just_testing) {
2035    $install = "test($install)";
2036  } elsif ($options{'no-module-tests'}) {
2037    $install = "notest('install',$install)";
2038  } else {
2039    $install = "install($install)";
2040  }
2041  my $last = $m[-1];
2042  my $status_method = $just_testing ? 'test' : 'uptodate';
2043  my $shellcmd = "$install; die unless CPAN::Shell->expand(Module => '$last')->$status_method;";
2044
2045  if ($options{module} || $options{'test-module'}) {
2046    run_report_and_exit(@cpanshell, $shellcmd);
2047  } else {
2048    my $ret = run_with_options({setprgp => $options{setpgrp},
2049                                timeout => $options{timeout},
2050                               }, @cpanshell, $shellcmd);
2051    $ret &= 0xff if $options{crash};
2052
2053    # Failed? Give up
2054    if ($ret) {
2055      report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_");
2056    }
2057  }
2058}
2059
2060match_and_exit($real_target, @ARGV) if $match;
2061
2062if (defined $options{'one-liner'}) {
2063    my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl';
2064    unshift @ARGV, map {('-e', $_)} @{$options{'one-liner'}};
2065    foreach (qw(c l w)) {
2066        unshift @ARGV, "-$_" if $options{$_};
2067    }
2068    unshift @ARGV, "./$exe", '-Ilib';
2069}
2070
2071if (-f $ARGV[0]) {
2072    my $fh = open_or_die($ARGV[0]);
2073    my $line = <$fh>;
2074    unshift @ARGV, $1, '-Ilib'
2075        if $line =~ $run_with_our_perl;
2076}
2077
2078if ($options{valgrind}) {
2079    # Turns out to be too confusing to use an optional argument with the path
2080    # of the valgrind binary, as if --valgrind takes an optional argument,
2081    # then specifying it as the last option eats the first part of the testcase.
2082    # ie this: .../bisect.pl --valgrind testcase
2083    # is treated as --valgrind=testcase and as there is no test case given,
2084    # it's an invalid commandline, bailing out with the usage message.
2085
2086    # Currently, the test script can't signal a skip with 125, so anything
2087    # non-zero would do. But to keep that option open in future, use 124
2088    unshift @ARGV, 'valgrind', '--error-exitcode=124';
2089}
2090
2091# This is what we came here to run:
2092
2093if (exists $Config{ldlibpthname}) {
2094    require Cwd;
2095    my $varname = $Config{ldlibpthname};
2096    my $cwd = Cwd::getcwd();
2097    if (defined $ENV{$varname}) {
2098        $ENV{$varname} = $cwd . $Config{path_sep} . $ENV{$varname};
2099    } else {
2100        $ENV{$varname} = $cwd;
2101    }
2102}
2103
2104run_report_and_exit(@ARGV);
2105
2106############################################################################
2107#
2108# Patching, editing and faking routines only below here.
2109#
2110############################################################################
2111
2112sub fake_noextensions {
2113    edit_file('config.sh', sub {
2114                  my @lines = split /\n/, shift;
2115                  my @ext = split /\s+/, $defines{noextensions};
2116                  foreach (@lines) {
2117                      next unless /^extensions=/ || /^dynamic_ext/;
2118                      foreach my $ext (@ext) {
2119                          s/\b$ext( )?\b/$1/;
2120                      }
2121                  }
2122                  return join "\n", @lines;
2123              });
2124}
2125
2126sub force_manifest {
2127    my (@missing, @created_dirs);
2128    my $fh = open_or_die('MANIFEST');
2129    while (<$fh>) {
2130        next unless /^(\S+)/;
2131        # -d is special case needed (at least) between 27332437a2ed1941 and
2132        # bf3d9ec563d25054^ inclusive, as manifest contains ext/Thread/Thread
2133        push @missing, $1
2134            unless -f $1 || -d $1;
2135    }
2136    close_or_die($fh);
2137
2138    foreach my $pathname (@missing) {
2139        my @parts = split '/', $pathname;
2140        my $leaf = pop @parts;
2141        my $path = '.';
2142        while (@parts) {
2143            $path .= '/' . shift @parts;
2144            next if -d $path;
2145            mkdir $path, 0700 or die_255("Can't create $path: $!");
2146            unshift @created_dirs, $path;
2147        }
2148        $fh = open_or_die($pathname, '>');
2149        close_or_die($fh);
2150        chmod 0, $pathname or die_255("Can't chmod 0 $pathname: $!");
2151    }
2152    return \@missing, \@created_dirs;
2153}
2154
2155sub force_manifest_cleanup {
2156    my ($missing, $created_dirs) = @_;
2157    # This is probably way too paranoid:
2158    my @errors;
2159    require Fcntl;
2160    foreach my $file (@$missing) {
2161        my (undef, undef, $mode, undef, undef, undef, undef, $size)
2162            = stat $file;
2163        if (!defined $mode) {
2164            push @errors, "Added file $file has been deleted by Configure";
2165            next;
2166        }
2167        if (Fcntl::S_IMODE($mode) != 0) {
2168            push @errors,
2169                sprintf 'Added file %s had mode changed by Configure to %03o',
2170                    $file, $mode;
2171        }
2172        if ($size != 0) {
2173            push @errors,
2174                "Added file $file had sized changed by Configure to $size";
2175        }
2176        unlink $file or die_255("Can't unlink $file: $!");
2177    }
2178    foreach my $dir (@$created_dirs) {
2179        rmdir $dir or die_255("Can't rmdir $dir: $!");
2180    }
2181    skip("@errors")
2182        if @errors;
2183}
2184
2185sub patch_Configure {
2186    if ($major < 1) {
2187        if (extract_from_file('Configure',
2188                              qr/^\t\t\*=\*\) echo "\$1" >> \$optdef;;$/)) {
2189            # This is "        Spaces now allowed in -D command line options.",
2190            # part of commit ecfc54246c2a6f42
2191            apply_patch(<<'EOPATCH');
2192diff --git a/Configure b/Configure
2193index 3d3b38d..78ffe16 100755
2194--- a/Configure
2195+++ b/Configure
2196@@ -652,7 +777,8 @@ while test $# -gt 0; do
2197 			echo "$me: use '-U symbol=', not '-D symbol='." >&2
2198 			echo "$me: ignoring -D $1" >&2
2199 			;;
2200-		*=*) echo "$1" >> $optdef;;
2201+		*=*) echo "$1" | \
2202+				sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;;
2203 		*) echo "$1='define'" >> $optdef;;
2204 		esac
2205 		shift
2206EOPATCH
2207        }
2208
2209        if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) {
2210            # Configure's original simple "grep" for d_namlen falls foul of the
2211            # approach taken by the glibc headers:
2212            # #ifdef _DIRENT_HAVE_D_NAMLEN
2213            # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen)
2214            #
2215            # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux.
2216            # This is also part of commit ecfc54246c2a6f42
2217            apply_patch(<<'EOPATCH');
2218diff --git a/Configure b/Configure
2219index 3d3b38d..78ffe16 100755
2220--- a/Configure
2221+++ b/Configure
2222@@ -3935,7 +4045,8 @@ $rm -f try.c
2223
2224 : see if the directory entry stores field length
2225 echo " "
2226-if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
2227+$cppstdin $cppflags $cppminus < "$xinc" > try.c
2228+if $contains 'd_namlen' try.c >/dev/null 2>&1; then
2229 	echo "Good, your directory entry keeps length information in d_namlen." >&4
2230 	val="$define"
2231 else
2232EOPATCH
2233        }
2234    }
2235
2236    if ($major < 2
2237        && !extract_from_file('Configure',
2238                              qr/Try to guess additional flags to pick up local libraries/)) {
2239        my $mips = extract_from_file('Configure',
2240                                     qr!(''\) if (?:\./)?mips; then)!);
2241        # This is part of perl-5.001n. It's needed, to add -L/usr/local/lib to
2242        # the ld flags if libraries are found there. It shifts the code to set
2243        # up libpth earlier, and then adds the code to add libpth entries to
2244        # ldflags
2245        # mips was changed to ./mips in ecfc54246c2a6f42, perl5.000 patch.0g
2246        apply_patch(sprintf <<'EOPATCH', $mips);
2247diff --git a/Configure b/Configure
2248index 53649d5..0635a6e 100755
2249--- a/Configure
2250+++ b/Configure
2251@@ -2749,6 +2749,52 @@ EOM
2252 	;;
2253 esac
2254
2255+: Set private lib path
2256+case "$plibpth" in
2257+'') if ./mips; then
2258+		plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
2259+	fi;;
2260+esac
2261+case "$libpth" in
2262+' ') dlist='';;
2263+'') dlist="$plibpth $glibpth";;
2264+*) dlist="$libpth";;
2265+esac
2266+
2267+: Now check and see which directories actually exist, avoiding duplicates
2268+libpth=''
2269+for xxx in $dlist
2270+do
2271+    if $test -d $xxx; then
2272+		case " $libpth " in
2273+		*" $xxx "*) ;;
2274+		*) libpth="$libpth $xxx";;
2275+		esac
2276+    fi
2277+done
2278+$cat <<'EOM'
2279+
2280+Some systems have incompatible or broken versions of libraries.  Among
2281+the directories listed in the question below, please remove any you
2282+know not to be holding relevant libraries, and add any that are needed.
2283+Say "none" for none.
2284+
2285+EOM
2286+case "$libpth" in
2287+'') dflt='none';;
2288+*)
2289+	set X $libpth
2290+	shift
2291+	dflt=${1+"$@"}
2292+	;;
2293+esac
2294+rp="Directories to use for library searches?"
2295+. ./myread
2296+case "$ans" in
2297+none) libpth=' ';;
2298+*) libpth="$ans";;
2299+esac
2300+
2301 : flags used in final linking phase
2302 case "$ldflags" in
2303 '') if ./venix; then
2304@@ -2765,6 +2811,23 @@ case "$ldflags" in
2305 	;;
2306 *) dflt="$ldflags";;
2307 esac
2308+
2309+: Possible local library directories to search.
2310+loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib"
2311+loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib"
2312+
2313+: Try to guess additional flags to pick up local libraries.
2314+for thislibdir in $libpth; do
2315+	case " $loclibpth " in
2316+	*" $thislibdir "*)
2317+		case "$dflt " in
2318+		"-L$thislibdir ") ;;
2319+		*)  dflt="$dflt -L$thislibdir" ;;
2320+		esac
2321+		;;
2322+	esac
2323+done
2324+
2325 echo " "
2326 rp="Any additional ld flags (NOT including libraries)?"
2327 . ./myread
2328@@ -2828,52 +2891,6 @@ n) echo "OK, that should do.";;
2329 esac
2330 $rm -f try try.* core
2331
2332-: Set private lib path
2333-case "$plibpth" in
2334-%s
2335-		plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
2336-	fi;;
2337-esac
2338-case "$libpth" in
2339-' ') dlist='';;
2340-'') dlist="$plibpth $glibpth";;
2341-*) dlist="$libpth";;
2342-esac
2343-
2344-: Now check and see which directories actually exist, avoiding duplicates
2345-libpth=''
2346-for xxx in $dlist
2347-do
2348-    if $test -d $xxx; then
2349-		case " $libpth " in
2350-		*" $xxx "*) ;;
2351-		*) libpth="$libpth $xxx";;
2352-		esac
2353-    fi
2354-done
2355-$cat <<'EOM'
2356-
2357-Some systems have incompatible or broken versions of libraries.  Among
2358-the directories listed in the question below, please remove any you
2359-know not to be holding relevant libraries, and add any that are needed.
2360-Say "none" for none.
2361-
2362-EOM
2363-case "$libpth" in
2364-'') dflt='none';;
2365-*)
2366-	set X $libpth
2367-	shift
2368-	dflt=${1+"$@"}
2369-	;;
2370-esac
2371-rp="Directories to use for library searches?"
2372-. ./myread
2373-case "$ans" in
2374-none) libpth=' ';;
2375-*) libpth="$ans";;
2376-esac
2377-
2378 : compute shared library extension
2379 case "$so" in
2380 '')
2381EOPATCH
2382    }
2383
2384    if ($major < 4 && extract_from_file('Configure',
2385                                        qr/: see which flavor of setpgrp is in use/)) {
2386        edit_file('Configure', sub {
2387                      my $code = shift;
2388                      my $new = <<'EOT';
2389if $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1; then
2390EOT
2391                      chomp $new;
2392
2393                      # before commit ecfc54246c2a6f42:
2394                      # before commit 8e07c86ebc651fe9:
2395                      my @old = (<<'EOT', <<'EOT');
2396if $cc $ccflags -o set $ldflags set.c $libs >/dev/null 2>&1; then
2397EOT
2398if $cc $ccflags -o set set.c $ldflags $libs >/dev/null 2>&1; then
2399EOT
2400                      for my $was (@old) {
2401                          # Yes, this modifies @old. No problem here:
2402                          chomp $was;
2403                          $was = quotemeta $was;
2404                          $code =~ s/$was/$new/;
2405                      }
2406
2407                      # also commit ecfc54246c2a6f42:
2408                      $code =~ s!\tif usg; then!\tif ./usg; then!;
2409
2410                      return $code;
2411                  });
2412
2413        # We need the new probe from 2afac517c48c20de, which has prototypes
2414        # (but include the various C headers unconditionally)
2415        apply_patch(<<'EOPATCH');
2416diff --git a/Configure b/Configure
2417index 18f2172435..5a75ebd767 100755
2418--- a/Configure
2419+++ b/Configure
2420@@ -4986,45 +5055,61 @@ eval $inlibc
2421 set setpgrp d_setpgrp
2422 eval $inlibc
2423
2424-: see which flavor of setpgrp is in use
2425+echo "Checking to see which flavor of setpgrp is in use . . . "
2426 case "$d_setpgrp" in
2427 "$define")
2428 	echo " "
2429 	$cat >set.c <<EOP
2430+#include <stdio.h>
2431+#include <sys/types.h>
2432+#include <unistd.h>
2433 main()
2434 {
2435 	if (getuid() == 0) {
2436 		printf("(I see you are running Configure as super-user...)\n");
2437 		setuid(1);
2438 	}
2439+#ifdef TRY_BSD_PGRP
2440 	if (-1 == setpgrp(1, 1))
2441-		exit(1);
2442-	exit(0);
2443+		exit(0);
2444+#else
2445+	if (setpgrp() != -1)
2446+		exit(0);
2447+#endif
2448+	exit(1);
2449 }
2450 EOP
2451-	if $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1; then
2452-		./set 2>/dev/null
2453-		case $? in
2454-		0) echo "You have to use setpgrp() instead of setpgrp(pid, pgrp)." >&4
2455-			val="$undef";;
2456-		*) echo "You have to use setpgrp(pid, pgrp) instead of setpgrp()." >&4
2457-			val="$define";;
2458-		esac
2459+	if $cc -DTRY_BSD_PGRP $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1 && ./set; then
2460+		echo 'You have to use setpgrp(pid,pgrp) instead of setpgrp().' >&4
2461+		val="$define"
2462+	elif $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1 && ./set; then
2463+		echo 'You have to use setpgrp() instead of setpgrp(pid,pgrp).' >&4
2464+		val="$undef"
2465 	else
2466+		echo "I can't seem to compile and run the test program."
2467 		if ./usg; then
2468-			xxx="USG one, i.e. you use setpgrp()."
2469-			val="$undef"
2470+			xxx="a USG one, i.e. you use setpgrp()."
2471 		else
2472-			xxx="BSD one, i.e. you use setpgrp(pid, pgrp)."
2473-			val="$define"
2474+			# SVR4 systems can appear rather BSD-ish.
2475+			case "$i_unistd" in
2476+			$undef)
2477+				xxx="a BSD one, i.e. you use setpgrp(pid,pgrp)."
2478+				val="$define"
2479+				;;
2480+			$define)
2481+				xxx="probably a USG one, i.e. you use setpgrp()."
2482+				val="$undef"
2483+				;;
2484+			esac
2485 		fi
2486-		echo "Assuming your setpgrp is a $xxx" >&4
2487+		echo "Assuming your setpgrp is $xxx" >&4
2488 	fi
2489 	;;
2490 *) val="$undef";;
2491 esac
2492-set d_bsdpgrp
2493+set d_bsdsetpgrp
2494 eval $setvar
2495+d_bsdpgrp=$d_bsdsetpgrp
2496 $rm -f set set.c
2497
2498 : see if bzero exists
2499EOPATCH
2500    }
2501
2502    if ($major == 4 && extract_from_file('Configure', qr/^d_gethbynam=/)) {
2503        # Fixes a bug introduced in 4599a1dedd47b916
2504        apply_commit('3cbc818d1d0ac470');
2505    }
2506
2507    if ($major == 4 && extract_from_file('Configure',
2508                                         qr/gethbadd_addr_type=`echo \$gethbadd_addr_type/)) {
2509        # Fixes a bug introduced in 3fd537d4b944bc7a
2510        apply_commit('6ff9219da6cf8cfd');
2511    }
2512
2513    if ($major == 4 && extract_from_file('Configure',
2514                                         qr/^pthreads_created_joinable=/)) {
2515        # Fix for bug introduced in 52e1cb5ebf5e5a8c
2516        # Part of commit ce637636a41b2fef
2517        edit_file('Configure', sub {
2518                      my $code = shift;
2519                      $code =~ s{^pthreads_created_joinable=''}
2520                                {d_pthreads_created_joinable=''}ms
2521                                    or die_255("Substitution failed");
2522                      $code =~ s{^pthreads_created_joinable='\$pthreads_created_joinable'}
2523                                {d_pthreads_created_joinable='\$d_pthreads_created_joinable'}ms
2524                           or die_255("Substitution failed");
2525                      return $code;
2526                  });
2527    }
2528
2529    if ($major < 5 && extract_from_file('Configure',
2530                                        qr!if \$cc \$ccflags try\.c -o try >/dev/null 2>&1; then!)) {
2531        # Analogous to the more general fix of dfe9444ca7881e71
2532        # Without this flags such as -m64 may not be passed to this compile,
2533        # which results in a byteorder of '1234' instead of '12345678', which
2534        # can then cause crashes.
2535
2536        if (extract_from_file('Configure', qr/xxx_prompt=y/)) {
2537            # 8e07c86ebc651fe9 or later
2538            # ("This is my patch  patch.1n  for perl5.001.")
2539            apply_patch(<<'EOPATCH');
2540diff --git a/Configure b/Configure
2541index 62249dd..c5c384e 100755
2542--- a/Configure
2543+++ b/Configure
2544@@ -8247,7 +8247,7 @@ main()
2545 }
2546 EOCP
2547 	xxx_prompt=y
2548-	if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
2549+	if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
2550 		dflt=`./try`
2551 		case "$dflt" in
2552 		[1-4][1-4][1-4][1-4]|12345678|87654321)
2553EOPATCH
2554        } else {
2555            apply_patch(<<'EOPATCH');
2556diff --git a/Configure b/Configure
2557index 53649d5..f1cd64a 100755
2558--- a/Configure
2559+++ b/Configure
2560@@ -6362,7 +6362,7 @@ main()
2561 	printf("\n");
2562 }
2563 EOCP
2564-	if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then
2565+	if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 ; then
2566 		dflt=`./try`
2567 		case "$dflt" in
2568 		????|????????) echo "(The test program ran ok.)";;
2569EOPATCH
2570        }
2571    }
2572
2573    if ($major < 5) {
2574        my $what = extract_from_file('Configure', qr!(\s+)return __libc_main!);
2575        if ($what) {
2576            # To add to the fun commit commit dfe9444ca7881e71 in Feb 1988
2577            # changed several things:
2578            if ($what !~ /\t/) {
2579                apply_patch(<<'EOPATCH');
2580--- a/Configure
2581+++ b/Configure
2582@@ -3854,11 +3911,12 @@ n) echo "OK, that should do.";;
2583 int
2584 main()
2585 {
2586-  return __libc_main();
2587+	return __libc_main();
2588 }
2589 EOM
2590-if $cc $ccflags $ldflags -o gnulibc gnulibc.c $libs >/dev/null 2>&1 && \
2591-    ./gnulibc | $contains '^GNU C Library' >/dev/null 2>&1; then
2592+set gnulibc
2593+if eval $compile && \
2594+  ./gnulibc | $contains '^GNU C Library' >/dev/null 2>&1; then
2595 	val="$define"
2596 	echo "You are using the GNU C Library"
2597 else
2598EOPATCH
2599            }
2600
2601            # And commit dc45a647708b6c54 tweaks 1 line in April 1998
2602            edit_file('Configure', sub {
2603                          my $code = shift;
2604                          $code =~ s{contains '\^GNU C Library' >/dev/null 2>&1; then}
2605                                    {contains '^GNU C Library'; then};
2606                          return $code;
2607                      });
2608
2609            # This is part of aebf16e7cdbc86ec from June 1998
2610            # but with compiles_ok inlined
2611            apply_patch(<<'EOPATCH');
2612diff --git a/Configure b/Configure
2613index 38072f0e5e..43735feacf 100755
2614--- a/Configure
2615+++ b/Configure
2616@@ -4024,15 +4024,19 @@ $cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;'
2617 echo " "
2618 echo "Checking for GNU C Library..." >&4
2619 cat >gnulibc.c <<EOM
2620+#include <stdio.h>
2621 int
2622 main()
2623 {
2624-	return __libc_main();
2625+#ifdef __GLIBC__
2626+    exit(0);
2627+#else
2628+    exit(1);
2629+#endif
2630 }
2631 EOM
2632 set gnulibc
2633-if eval $compile && \
2634-  ./gnulibc | $contains '^GNU C Library'; then
2635+if $cc $ccflags $ldflags -o gnulibc gnulibc.c $libs && ./gnulibc; then
2636 	val="$define"
2637 	echo "You are using the GNU C Library"
2638 else
2639EOPATCH
2640        }
2641    }
2642
2643    if ($major < 6 && !extract_from_file('Configure',
2644                                         qr!^\t-A\)$!)) {
2645        # This adds the -A option to Configure, which is incredibly useful
2646        # Effectively this is commits 02e93a22d20fc9a5, 5f83a3e9d818c3ad,
2647        # bde6b06b2c493fef, f7c3111703e46e0c and 2 lines of trailing whitespace
2648        # removed by 613d6c3e99b9decc, but applied at slightly different
2649        # locations to ensure a clean patch back to 5.000
2650        # Note, if considering patching to the intermediate revisions to fix
2651        # bugs in -A handling, f7c3111703e46e0c is from 2002, and hence
2652        # $major == 8
2653
2654        # To add to the fun, early patches add -K and -O options, and it's not
2655        # trivial to get patch to put the C<. ./posthint.sh> in the right place
2656        edit_file('Configure', sub {
2657                      my $code = shift;
2658                      $code =~ s/(optstr = ")([^"]+";\s*# getopt-style specification)/$1A:$2/
2659                          or die_255("Substitution failed");
2660                      $code =~ s!^(: who configured the system)!
2661touch posthint.sh
2662. ./posthint.sh
2663
2664$1!ms
2665                          or die_255("Substitution failed");
2666                      return $code;
2667                  });
2668        apply_patch(<<'EOPATCH');
2669diff --git a/Configure b/Configure
2670index 4b55fa6..60c3c64 100755
2671--- a/Configure
2672+++ b/Configure
2673@@ -1150,6 +1150,7 @@ set X `for arg in "$@"; do echo "X$arg"; done |
2674 eval "set $*"
2675 shift
2676 rm -f options.awk
2677+rm -f posthint.sh
2678
2679 : set up default values
2680 fastread=''
2681@@ -1172,6 +1173,56 @@ while test $# -gt 0; do
2682 	case "$1" in
2683 	-d) shift; fastread=yes;;
2684 	-e) shift; alldone=cont;;
2685+	-A)
2686+	    shift
2687+	    xxx=''
2688+	    yyy="$1"
2689+	    zzz=''
2690+	    uuu=undef
2691+	    case "$yyy" in
2692+            *=*) zzz=`echo "$yyy"|sed 's!=.*!!'`
2693+                 case "$zzz" in
2694+                 *:*) zzz='' ;;
2695+                 *)   xxx=append
2696+                      zzz=" "`echo "$yyy"|sed 's!^[^=]*=!!'`
2697+                      yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
2698+                 esac
2699+                 ;;
2700+            esac
2701+            case "$xxx" in
2702+            '')  case "$yyy" in
2703+                 *:*) xxx=`echo "$yyy"|sed 's!:.*!!'`
2704+                      yyy=`echo "$yyy"|sed 's!^[^:]*:!!'`
2705+                      zzz=`echo "$yyy"|sed 's!^[^=]*=!!'`
2706+                      yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
2707+                 *)   xxx=`echo "$yyy"|sed 's!:.*!!'`
2708+                      yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` ;;
2709+                 esac
2710+                 ;;
2711+            esac
2712+	    case "$xxx" in
2713+	    append)
2714+		echo "$yyy=\"\${$yyy}$zzz\""	>> posthint.sh ;;
2715+	    clear)
2716+		echo "$yyy=''"			>> posthint.sh ;;
2717+	    define)
2718+	        case "$zzz" in
2719+		'') zzz=define ;;
2720+		esac
2721+		echo "$yyy='$zzz'"		>> posthint.sh ;;
2722+	    eval)
2723+		echo "eval \"$yyy=$zzz\""	>> posthint.sh ;;
2724+	    prepend)
2725+		echo "$yyy=\"$zzz\${$yyy}\""	>> posthint.sh ;;
2726+	    undef)
2727+	        case "$zzz" in
2728+		'') zzz="$uuu" ;;
2729+		esac
2730+		echo "$yyy=$zzz"		>> posthint.sh ;;
2731+            *)  echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2 ;;
2732+	    esac
2733+	    shift
2734+	    ;;
2735 	-f)
2736 		shift
2737 		cd ..
2738EOPATCH
2739    }
2740
2741    if ($major < 6) {
2742        edit_file('Configure', sub {
2743                      my $code = shift;
2744                      # This will cause a build failure, but it will stop
2745                      # Configure looping endlessly trying to get a different
2746                      # answer:
2747                      $code =~ s{(dflt=)n(\n\s+rp="Function \$ans does not exist)}
2748                                {$1y$2};
2749                      return $code;
2750                  });
2751    }
2752
2753    if ($major < 8 && $^O eq 'aix') {
2754        edit_file('Configure', sub {
2755                      my $code = shift;
2756                      # Replicate commit a8c676c69574838b
2757                      # Whitespace allowed at the ends of /lib/syscalls.exp lines
2758                      # and half of commit c6912327ae30e6de
2759                      # AIX syscalls.exp scan: the syscall might be marked 32, 3264, or 64
2760                      $code =~ s{(\bsed\b.*\bsyscall)(?:\[0-9\]\*)?(\$.*/lib/syscalls\.exp)}
2761                                {$1 . "[0-9]*[ \t]*" . $2}e;
2762                      return $code;
2763                  });
2764    }
2765
2766    if ($major < 8 && !extract_from_file('Configure',
2767                                         qr/^\t\tif test ! -t 0; then$/)) {
2768        # Before dfe9444ca7881e71, Configure would refuse to run if stdin was
2769        # not a tty. With that commit, the tty requirement was dropped for -de
2770        # and -dE
2771        # Commit aaeb8e512e8e9e14 dropped the tty requirement for -S
2772        # For those older versions, it's probably easiest if we simply remove
2773        # the sanity test.
2774        edit_file('Configure', sub {
2775                      my $code = shift;
2776                      $code =~ s/test ! -t 0/test Perl = rules/;
2777                      return $code;
2778                  });
2779    }
2780
2781    if ($major < 32) {
2782        edit_file('Configure', sub {
2783                      my $code = shift;
2784
2785                      # A lot of the probes used to be written assuming no need
2786                      # for prototypes for exit(), printf() etc.
2787                      # Curiously also the code was written to call exit()
2788                      # rather than return from main - early portability?
2789                      #
2790                      # Commit 55954f198635e488 did most of the work in ensuring
2791                      # that there was always a prototype for exit, by adding
2792                      # #include <stdlib.h> in many probes. However the last
2793                      # missing prototype was only addressed by f16c94bc75aefb81
2794                      # (for futimes), and the last missing prototypes a few
2795                      # commits later in f82f0f36c7188b6d
2796                      #
2797                      # As an aside, commit dc45a647708b6c54 fixes the signal
2798                      # name probe (etc) - the commit tagged as perl-5.004_01
2799                      # *seems* to fix the signal name probe, but actually it
2800                      # fixes an error in the fallback awk code, not the C
2801                      # probe's missing prototype.
2802                      #
2803                      # With current C compilers there is no correctness risk
2804                      # from including a header more than once, so the easiest
2805                      # approach to making this all work is to add includes
2806                      # "to be sure to be sure"
2807                      #
2808                      # The trick is not to break *working* probes by
2809                      # accidentally including a header *within* a construction.
2810                      # So we need to have some confidence that it's the start
2811                      # of a file (or somewhere safe)
2812
2813                      my $headers = <<'EOFIX';
2814#include <stdio.h>
2815#include <stdlib.h>
2816#include <string.h>
2817EOFIX
2818
2819                      # This handles $cat and plain cat:
2820                      $code =~ s{([\$\t\n ]cat > *[a-z0-9]+\.c <<[^\n]*\n)}
2821                                {$1$headers}g;
2822                      # Of course, there's always one that's backwards:
2823                      $code =~ s{([\$\t\n ]cat <<[^\n]* > *[a-z0-9]+\.c\n)}
2824                                {$1$headers}g;
2825
2826                      # and >> used to *create* a file.
2827                      # We have to be careful to distinguish those from >> used
2828                      # to append to a file. All the first lines have #include
2829                      # or #ifdef. Except the few that don't...
2830                      $code =~ s{
2831                                    ([\$\t\n ]cat\ >>\ *[a-z]+\.c\ <<[^\n]*\n)
2832                                    (
2833                                        # #include/#ifdef ...
2834                                        \#
2835                                    |
2836                                        # The non-blocking IO probe
2837                                        (?:int\ )?main\(\)
2838                                    |
2839                                        # The alignment constraint probe
2840                                        struct\ foobar
2841                                    )
2842                                }
2843                                {$1$headers$2}gx;
2844
2845                      # This is part of commit c727eafaa06ca49a:
2846                      $code =~ s{\(int\)exit\(0\);}
2847                                {\(void\)exit\(0\);};
2848
2849                      return $code;
2850                  });
2851    }
2852
2853    if ($major < 10) {
2854        # Fix symbol detection to that of commit 373dfab3839ca168 if it's any
2855        # intermediate version 5129fff43c4fe08c or later, as the intermediate
2856        # versions don't work correctly on (at least) Sparc Linux.
2857        # 5129fff43c4fe08c adds the first mention of mistrustnm.
2858        # 373dfab3839ca168 removes the last mention of lc=""
2859        #
2860        # Fix symbol detection prior to 5129fff43c4fe08c to use the same
2861        # approach, where we don't call printf without a prototype
2862        # We can't include <stdio.h> to get its prototype, as the way this works
2863        # is to create a (wrong) prototype for the probed functions, and those
2864        # conflict if the function in question is in stdio.h.
2865        edit_file('Configure', sub {
2866                      my $code = shift;
2867                      return $code
2868                          if $code !~ /\btc="";/; # 373dfab3839ca168 or later
2869                      if ($code !~ /\bmistrustnm\b/) {
2870                          # doing this as a '' heredoc seems to be the easiest
2871                          # way to avoid confusing levels of backslashes:
2872                          my $now = <<'EOT';
2873void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }
2874EOT
2875                          chomp $now;
2876
2877                          # before 5129fff43c4fe08c
2878                          # befure 16d20bd98cd29be7
2879                          my @old = (<<'EOT', <<'EOT');
2880main() { extern short $1$tdc; printf(\"%hd\", $1$tc); }
2881EOT
2882main() { extern int $1$tdc; printf(\"%d\", $1$tc); }
2883EOT
2884                          for my $was (@old) {
2885                              chomp $was;
2886                              $was = quotemeta $was;
2887
2888                              # Prior to commit d674cd6de52ff38b there was no
2889                              # 'int ' for 'int main'
2890                              $code =~ s/(?:int )?$was/$now/;
2891                          }
2892                          return $code;
2893                      }
2894
2895                      my $fixed = <<'EOC';
2896
2897: is a C symbol defined?
2898csym='tlook=$1;
2899case "$3" in
2900-v) tf=libc.tmp; tdc="";;
2901-a) tf=libc.tmp; tdc="[]";;
2902*) tlook="^$1\$"; tf=libc.list; tdc="()";;
2903esac;
2904tx=yes;
2905case "$reuseval-$4" in
2906true-) ;;
2907true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;;
2908esac;
2909case "$tx" in
2910yes)
2911	tval=false;
2912	if $test "$runnm" = true; then
2913		if $contains $tlook $tf >/dev/null 2>&1; then
2914			tval=true;
2915		elif $test "$mistrustnm" = compile -o "$mistrustnm" = run; then
2916			echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
2917			$cc -o try $optimize $ccflags $ldflags try.c >/dev/null 2>&1 $libs && tval=true;
2918			$test "$mistrustnm" = run -a -x try && { $run ./try$_exe >/dev/null 2>&1 || tval=false; };
2919			$rm -f try$_exe try.c core core.* try.core;
2920		fi;
2921	else
2922		echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
2923		$cc -o try $optimize $ccflags $ldflags try.c $libs >/dev/null 2>&1 && tval=true;
2924		$rm -f try$_exe try.c;
2925	fi;
2926	;;
2927*)
2928	case "$tval" in
2929	$define) tval=true;;
2930	*) tval=false;;
2931	esac;
2932	;;
2933esac;
2934eval "$2=$tval"'
2935
2936EOC
2937                      $code =~ s/\n: is a C symbol defined\?\n.*?\neval "\$2=\$tval"'\n\n/$fixed/sm
2938                          or die_255("substitution failed");
2939                      return $code;
2940                  });
2941    }
2942
2943    if ($major < 10
2944        && extract_from_file('Configure', qr/^set malloc\.h i_malloc$/)) {
2945        # This is commit 01d07975f7ef0e7d, trimmed, with $compile inlined as
2946        # prior to bd9b35c97ad661cc Configure had the malloc.h test before the
2947        # definition of $compile.
2948        apply_patch(<<'EOPATCH');
2949diff --git a/Configure b/Configure
2950index 3d2e8b9..6ce7766 100755
2951--- a/Configure
2952+++ b/Configure
2953@@ -6743,5 +6743,22 @@ set d_dosuid
2954
2955 : see if this is a malloc.h system
2956-set malloc.h i_malloc
2957-eval $inhdr
2958+: we want a real compile instead of Inhdr because some systems have a
2959+: malloc.h that just gives a compile error saying to use stdlib.h instead
2960+echo " "
2961+$cat >try.c <<EOCP
2962+#include <stdlib.h>
2963+#include <malloc.h>
2964+int main () { return 0; }
2965+EOCP
2966+set try
2967+if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then
2968+    echo "<malloc.h> found." >&4
2969+    val="$define"
2970+else
2971+    echo "<malloc.h> NOT found." >&4
2972+    val="$undef"
2973+fi
2974+$rm -f try.c try
2975+set i_malloc
2976+eval $setvar
2977
2978EOPATCH
2979    }
2980
2981    if ($major < 38 && !extract_from_file('Configure', qr/Too many attempts asking the same question/)) {
2982        # Without this, myread can loop infinitely trying to get a valid answer,
2983        # and hence Configure gets stuck in a loop, outputting the same question
2984        # repeatedly. This isn't what we need.
2985        apply_commit('46bfb3c49f22629a');
2986    }
2987}
2988
2989sub patch_hints {
2990    if ($^O eq 'freebsd') {
2991        # There are rather too many version-specific FreeBSD hints fixes to
2992        # patch individually. Also, more than once the FreeBSD hints file has
2993        # been written in what turned out to be a rather non-future-proof style,
2994        # with case statements treating the most recent version as the
2995        # exception, instead of treating previous versions' behaviour explicitly
2996        # and changing the default to cater for the current behaviour. (As
2997        # strangely, future versions inherit the current behaviour.)
2998        checkout_file('hints/freebsd.sh');
2999    } elsif ($^O eq 'darwin') {
3000        if ($major < 8) {
3001            # We can't build on darwin without some of the data in the hints
3002            # file. Probably less surprising to use the earliest version of
3003            # hints/darwin.sh and then edit in place just below, than use
3004            # blead's version, as that would create a discontinuity at
3005            # f556e5b971932902 - before it, hints bugs would be "fixed", after
3006            # it they'd resurface. This way, we should give the illusion of
3007            # monotonic bug fixing.
3008            my $faking_it;
3009            if (!-f 'hints/darwin.sh') {
3010                checkout_file('hints/darwin.sh', 'f556e5b971932902');
3011                ++$faking_it;
3012            }
3013
3014            edit_file('hints/darwin.sh', sub {
3015                      my $code = shift;
3016                      # Part of commit 8f4f83badb7d1ba9, which mostly undoes
3017                      # commit 0511a818910f476c.
3018                      $code =~ s/^cppflags='-traditional-cpp';$/cppflags="\${cppflags} -no-cpp-precomp"/m;
3019                      # commit 14c11978e9b52e08/803bb6cc74d36a3f
3020                      # Without this, code in libperl.bundle links against op.o
3021                      # in preference to opmini.o on the linker command line,
3022                      # and hence miniperl tries to use File::Glob instead of
3023                      # csh
3024                      $code =~ s/^(lddlflags=)/ldflags="\${ldflags} -flat_namespace"\n$1/m;
3025                      # f556e5b971932902 also patches Makefile.SH with some
3026                      # special case code to deal with useshrplib for darwin.
3027                      # Given that post 5.8.0 the darwin hints default was
3028                      # changed to false, and it would be very complex to splice
3029                      # in that code in various versions of Makefile.SH back
3030                      # to 5.002, lets just turn it off.
3031                      $code =~ s/^useshrplib='true'/useshrplib='false'/m
3032                          if $faking_it;
3033
3034                      # Part of commit d235852b65d51c44
3035                      # Don't do this on a case sensitive HFS+ partition, as it
3036                      # breaks the build for 5.003 and earlier.
3037                      if ($case_insensitive
3038                          && $code !~ /^firstmakefile=GNUmakefile/) {
3039                          $code .= "\nfirstmakefile=GNUmakefile;\n";
3040                      }
3041
3042                      return $code;
3043                  });
3044        }
3045
3046        if ($major < 8 ||
3047                ($major < 10 && !extract_from_file('ext/DynaLoader/Makefile.PL',
3048                                                   qr/sub MY::static /))) {
3049            edit_file('hints/darwin.sh', sub {
3050                          my $code = shift;
3051                          # As above, the build fails if version of code in op.o
3052                          # is linked to, instead of opmini.o
3053                          # We don't need this after commit 908fcb8bef8cbab8,
3054                          # which moves DynaLoader.o into the shared perl
3055                          # library, as it *also* redoes the build so that
3056                          # miniperl is linked against all the object files
3057                          # (explicitly excluding op.o), instead of against the
3058                          # shared library (and reyling on "flat namespaces"
3059                          # - ie make Mach-O behave like ELF - to end up with
3060                          # objects in the library linking against opmini.o)
3061                          $code .= <<'EOHACK';
3062
3063# Force a flat namespace everywhere:
3064echo $ldflags | grep flat_namespace || ldflags=`echo \$lddflags -flat_namespace`
3065echo $lddlflags | grep flat_namespace || lddlflags=`echo \$lddlflags -flat_namespace`
3066EOHACK
3067                          return $code;
3068                      });
3069        }
3070
3071        if ($major < 16) {
3072            edit_file('hints/darwin.sh', sub {
3073                          my $code = shift;
3074                          # This is commit 60a655a1ee05c577
3075                          $code =~ s/usenm='true'/usenm='false'/;
3076
3077                          # With the Configure probes fixed (in patch_Configure)
3078                          # the "d_stdstdio" logic now concludes "define".
3079                          # Unfortunately that is not correct - attempting to
3080                          # build 5.8.0 without this override results in SEGVs
3081                          # or similar chaos.
3082                          #
3083                          # The problem is introduced by commit 5a3a8a022aa61cba
3084                          # which enables perlio by default.
3085                          # The problem is hidden after 15b61c98f82f3010, which
3086                          # adds "d_faststdio" and defaults it to "undef" from
3087                          # that commit onwards, but override that and the build
3088                          # would break, up until "turning off perlio" was
3089                          # disabled by commit dd35fa16610ef2fa
3090                          $code .= "\nd_stdstdio='undef'\n";
3091
3092                          return $code;
3093                      });
3094        }
3095
3096        if ($major < 34) {
3097            edit_file('hints/darwin.sh', sub {
3098                      my $code = shift;
3099                      # This is commits aadc6422eaec39c2 and 54d41b60822734cf
3100                      # rolled into one:
3101                      $code =~ s/    10\.\*(?: \| 11\.\*)?\)/    [1-9][0-9].*)/g;
3102                      return $code;
3103                  });
3104        }
3105    } elsif ($^O eq 'netbsd') {
3106        if ($major < 6) {
3107            # These are part of commit 099685bc64c7dbce
3108            edit_file('hints/netbsd.sh', sub {
3109                          my $code = shift;
3110                          my $fixed = <<'EOC';
3111case "$osvers" in
31120.9|0.8*)
3113	usedl="$undef"
3114	;;
3115*)
3116	if [ -f /usr/libexec/ld.elf_so ]; then
3117		d_dlopen=$define
3118		d_dlerror=$define
3119		ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags"
3120		cccdlflags="-DPIC -fPIC $cccdlflags"
3121		lddlflags="--whole-archive -shared $lddlflags"
3122	elif [ "`uname -m`" = "pmax" ]; then
3123# NetBSD 1.3 and 1.3.1 on pmax shipped an 'old' ld.so, which will not work.
3124		d_dlopen=$undef
3125	elif [ -f /usr/libexec/ld.so ]; then
3126		d_dlopen=$define
3127		d_dlerror=$define
3128		ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags"
3129# we use -fPIC here because -fpic is *NOT* enough for some of the
3130# extensions like Tk on some netbsd platforms (the sparc is one)
3131		cccdlflags="-DPIC -fPIC $cccdlflags"
3132		lddlflags="-Bforcearchive -Bshareable $lddlflags"
3133	else
3134		d_dlopen=$undef
3135	fi
3136	;;
3137esac
3138EOC
3139                          $code =~ s/^case "\$osvers" in\n0\.9\|0\.8.*?^esac\n/$fixed/ms;
3140                          return $code;
3141                      });
3142        }
3143    } elsif ($^O eq 'openbsd') {
3144        if ($major < 8) {
3145            checkout_file('hints/openbsd.sh', '43051805d53a3e4c')
3146                unless -f 'hints/openbsd.sh';
3147            my $which = extract_from_file('hints/openbsd.sh',
3148                                          qr/# from (2\.8|3\.1) onwards/,
3149                                          '');
3150            if ($which eq '') {
3151                my $was = extract_from_file('hints/openbsd.sh',
3152                                            qr/(lddlflags="(?:-Bforcearchive )?-Bshareable)/);
3153                # This is commit 154d43cbcf57271c and parts of 5c75dbfa77b0949c
3154                # and 29b5585702e5e025
3155                apply_patch(sprintf <<'EOPATCH', $was);
3156diff --git a/hints/openbsd.sh b/hints/openbsd.sh
3157index a7d8bf2..5b79709 100644
3158--- a/hints/openbsd.sh
3159+++ b/hints/openbsd.sh
3160@@ -37,7 +37,25 @@ OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax)
3161 	# we use -fPIC here because -fpic is *NOT* enough for some of the
3162 	# extensions like Tk on some OpenBSD platforms (ie: sparc)
3163 	cccdlflags="-DPIC -fPIC $cccdlflags"
3164-	%s $lddlflags"
3165+	case "$osvers" in
3166+	[01].*|2.[0-7]|2.[0-7].*)
3167+		lddlflags="-Bshareable $lddlflags"
3168+		;;
3169+	2.[8-9]|3.0)
3170+		ld=${cc:-cc}
3171+		lddlflags="-shared -fPIC $lddlflags"
3172+		;;
3173+	*) # from 3.1 onwards
3174+		ld=${cc:-cc}
3175+		lddlflags="-shared -fPIC $lddlflags"
3176+		libswanted=`echo $libswanted | sed 's/ dl / /'`
3177+		;;
3178+	esac
3179+
3180+	# We need to force ld to export symbols on ELF platforms.
3181+	# Without this, dlopen() is crippled.
3182+	ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
3183+	test -n "$ELF" && ldflags="-Wl,-E $ldflags"
3184 	;;
3185 esac
3186
3187EOPATCH
3188            } elsif ($which eq '2.8') {
3189                # This is parts of 5c75dbfa77b0949c and 29b5585702e5e025, and
3190                # possibly eb9cd59d45ad2908
3191                my $was = extract_from_file('hints/openbsd.sh',
3192                                            qr/lddlflags="(-shared(?: -fPIC)?) \$lddlflags"/);
3193
3194                apply_patch(sprintf <<'EOPATCH', $was);
3195--- a/hints/openbsd.sh	2011-10-21 17:25:20.000000000 +0200
3196+++ b/hints/openbsd.sh	2011-10-21 16:58:43.000000000 +0200
3197@@ -44,11 +44,21 @@
3198 	[01].*|2.[0-7]|2.[0-7].*)
3199 		lddlflags="-Bshareable $lddlflags"
3200 		;;
3201-	*) # from 2.8 onwards
3202+	2.[8-9]|3.0)
3203 		ld=${cc:-cc}
3204-		lddlflags="%s $lddlflags"
3205+		lddlflags="-shared -fPIC $lddlflags"
3206+		;;
3207+	*) # from 3.1 onwards
3208+		ld=${cc:-cc}
3209+		lddlflags="-shared -fPIC $lddlflags"
3210+		libswanted=`echo $libswanted | sed 's/ dl / /'`
3211 		;;
3212 	esac
3213+
3214+	# We need to force ld to export symbols on ELF platforms.
3215+	# Without this, dlopen() is crippled.
3216+	ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
3217+	test -n "$ELF" && ldflags="-Wl,-E $ldflags"
3218 	;;
3219 esac
3220
3221EOPATCH
3222            } elsif ($which eq '3.1'
3223                     && !extract_from_file('hints/openbsd.sh',
3224                                           qr/We need to force ld to export symbols on ELF platforms/)) {
3225                # This is part of 29b5585702e5e025
3226                apply_patch(<<'EOPATCH');
3227diff --git a/hints/openbsd.sh b/hints/openbsd.sh
3228index c6b6bc9..4839d04 100644
3229--- a/hints/openbsd.sh
3230+++ b/hints/openbsd.sh
3231@@ -54,6 +54,11 @@ alpha-2.[0-8]|mips-*|vax-*|powerpc-2.[0-7]|m88k-*)
3232 		libswanted=`echo $libswanted | sed 's/ dl / /'`
3233 		;;
3234 	esac
3235+
3236+	# We need to force ld to export symbols on ELF platforms.
3237+	# Without this, dlopen() is crippled.
3238+	ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
3239+	test -n "$ELF" && ldflags="-Wl,-E $ldflags"
3240 	;;
3241 esac
3242
3243EOPATCH
3244            }
3245        }
3246    } elsif ($^O eq 'linux') {
3247        if ($major < 1) {
3248            # sparc linux seems to need the -Dbool=char -DHAS_BOOL part of
3249            # perl5.000 patch.0n: [address Configure and build issues]
3250            edit_file('hints/linux.sh', sub {
3251                          my $code = shift;
3252                          $code =~ s!-I/usr/include/bsd!-Dbool=char -DHAS_BOOL!g;
3253                          return $code;
3254                      });
3255        }
3256
3257        if ($major <= 9) {
3258            if (`uname -sm` =~ qr/^Linux sparc/) {
3259                if (extract_from_file('hints/linux.sh', qr/sparc-linux/)) {
3260                    # Be sure to use -fPIC not -fpic on Linux/SPARC
3261                    apply_commit('f6527d0ef0c13ad4');
3262                } elsif(!extract_from_file('hints/linux.sh',
3263                                           qr/^sparc-linux\)$/)) {
3264                    my $fh = open_or_die('hints/linux.sh', '>>');
3265                    print $fh <<'EOT' or die_255($!);
3266
3267case "`uname -m`" in
3268sparc*)
3269	case "$cccdlflags" in
3270	*-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;;
3271	*)	 cccdlflags="$cccdlflags -fPIC" ;;
3272	esac
3273	;;
3274esac
3275EOT
3276                    close_or_die($fh);
3277                }
3278            }
3279        }
3280    } elsif ($^O eq 'solaris') {
3281        if (($major == 13 || $major == 14)
3282            && extract_from_file('hints/solaris_2.sh', qr/getconfldllflags/)) {
3283            apply_commit('c80bde4388070c45');
3284        }
3285    }
3286}
3287
3288sub patch_SH {
3289    # Cwd.xs added in commit 0d2079faa739aaa9. Cwd.pm moved to ext/ 8 years
3290    # later in commit 403f501d5b37ebf0
3291    if ($major > 0 && <*/Cwd/Cwd.xs>) {
3292        if ($major < 10
3293            && !extract_from_file('Makefile.SH', qr/^extra_dep=''$/)) {
3294            # The Makefile.PL for Unicode::Normalize needs
3295            # lib/unicore/CombiningClass.pl. Even without a parallel build, we
3296            # need a dependency to ensure that it builds. This is a variant of
3297            # commit 9f3ef600c170f61e. Putting this for earlier versions gives
3298            # us a spot on which to hang the edits below
3299            apply_patch(<<'EOPATCH');
3300diff --git a/Makefile.SH b/Makefile.SH
3301index f61d0db..6097954 100644
3302--- a/Makefile.SH
3303+++ b/Makefile.SH
3304@@ -155,10 +155,20 @@ esac
3305
3306 : Prepare dependency lists for Makefile.
3307 dynamic_list=' '
3308+extra_dep=''
3309 for f in $dynamic_ext; do
3310     : the dependency named here will never exist
3311       base=`echo "$f" | sed 's/.*\///'`
3312-    dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext"
3313+    this_target="lib/auto/$f/$base.$dlext"
3314+    dynamic_list="$dynamic_list $this_target"
3315+
3316+    : Parallel makes reveal that we have some interdependencies
3317+    case $f in
3318+	Math/BigInt/FastCalc) extra_dep="$extra_dep
3319+$this_target: lib/auto/List/Util/Util.$dlext" ;;
3320+	Unicode/Normalize) extra_dep="$extra_dep
3321+$this_target: lib/unicore/CombiningClass.pl" ;;
3322+    esac
3323 done
3324
3325 static_list=' '
3326@@ -987,2 +997,9 @@ n_dummy $(nonxs_ext):	miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE
3327 	@$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
3328+!NO!SUBS!
3329+
3330+$spitshell >>Makefile <<EOF
3331+$extra_dep
3332+EOF
3333+
3334+$spitshell >>Makefile <<'!NO!SUBS!'
3335
3336EOPATCH
3337        }
3338
3339        if ($major == 15 && $^O !~ /^(linux|darwin|.*bsd)$/
3340            && extract_from_file('Makefile.SH', qr/^V.* \?= /)) {
3341            # Remove the GNU-make-ism (which the BSD makes also support, but
3342            # most other makes choke on)
3343            apply_patch(<<'EOPATCH');
3344diff --git a/Makefile.SH b/Makefile.SH
3345index 94952bd..13e9001 100755
3346--- a/Makefile.SH
3347+++ b/Makefile.SH
3348@@ -338,8 +338,8 @@ linux*|darwin)
3349 $spitshell >>$Makefile <<!GROK!THIS!
3350 # If you're going to use valgrind and it can't be invoked as plain valgrind
3351 # then you'll need to change this, or override it on the make command line.
3352-VALGRIND ?= valgrind
3353-VG_TEST  ?= ./perl -e 1 2>/dev/null
3354+VALGRIND = valgrind
3355+VG_TEST  = ./perl -e 1 2>/dev/null
3356
3357 !GROK!THIS!
3358 	;;
3359EOPATCH
3360        }
3361
3362        if ($major == 11) {
3363            if (extract_from_file('patchlevel.h',
3364                                  qr/^#include "unpushed\.h"/)) {
3365                # I had thought it easier to detect when building one of the 52
3366                # commits with the original method of incorporating the git
3367                # revision and drop parallel make flags. Commits shown by
3368                # git log 46807d8e809cc127^..dcff826f70bf3f64^ ^d4fb0a1f15d1a1c4
3369                # However, it's not actually possible to make miniperl for that
3370                # configuration as-is, because the file .patchnum is only made
3371                # as a side effect of target 'all'
3372                # I also don't think that it's "safe" to simply run
3373                # make_patchnum.sh before the build. We need the proper
3374                # dependency rules in the Makefile to *stop* it being run again
3375                # at the wrong time.
3376                # This range is important because contains the commit that
3377                # merges Schwern's y2038 work.
3378                apply_patch(<<'EOPATCH');
3379diff --git a/Makefile.SH b/Makefile.SH
3380index 9ad8b6f..106e721 100644
3381--- a/Makefile.SH
3382+++ b/Makefile.SH
3383@@ -540,9 +544,14 @@ sperl.i: perl.c $(h)
3384
3385 .PHONY: all translators utilities make_patchnum
3386
3387-make_patchnum:
3388+make_patchnum: lib/Config_git.pl
3389+
3390+lib/Config_git.pl: make_patchnum.sh
3391 	sh $(shellflags) make_patchnum.sh
3392
3393+# .patchnum, unpushed.h and lib/Config_git.pl are built by make_patchnum.sh
3394+unpushed.h .patchnum: lib/Config_git.pl
3395+
3396 # make sure that we recompile perl.c if .patchnum changes
3397 perl$(OBJ_EXT): .patchnum unpushed.h
3398
3399EOPATCH
3400            } elsif (-f '.gitignore'
3401                     && extract_from_file('.gitignore', qr/^\.patchnum$/)) {
3402                # 8565263ab8a47cda to 46807d8e809cc127^ inclusive.
3403                edit_file('Makefile.SH', sub {
3404                              my $code = shift;
3405                              $code =~ s/^make_patchnum:\n/make_patchnum: .patchnum
3406
3407.sha1: .patchnum
3408
3409.patchnum: make_patchnum.sh
3410/m;
3411                              return $code;
3412                          });
3413            } elsif (-f 'lib/.gitignore'
3414                     && extract_from_file('lib/.gitignore',
3415                                          qr!^/Config_git.pl!)
3416                     && !extract_from_file('Makefile.SH',
3417                                        qr/^uudmap\.h.*:bitcount.h$/)) {
3418                # Between commits and dcff826f70bf3f64 and 0f13ebd5d71f8177^
3419                edit_file('Makefile.SH', sub {
3420                              my $code = shift;
3421                              # Bug introduced by 344af494c35a9f0f
3422                              # fixed in 0f13ebd5d71f8177
3423                              $code =~ s{^(pod/perlapi\.pod) (pod/perlintern\.pod): }
3424                                        {$1: $2\n\n$2: }m;
3425                              # Bug introduced by efa50c51e3301a2c
3426                              # fixed in 0f13ebd5d71f8177
3427                              $code =~ s{^(uudmap\.h) (bitcount\.h): }
3428                                        {$1: $2\n\n$2: }m;
3429
3430                              # The rats nest of getting git_version.h correct
3431
3432                              if ($code =~ s{git_version\.h: stock_git_version\.h
3433\tcp stock_git_version\.h git_version\.h}
3434                                            {}m) {
3435                                  # before 486cd780047ff224
3436
3437                                  # We probably can't build between
3438                                  # 953f6acfa20ec275^ and 8565263ab8a47cda
3439                                  # inclusive, but all commits in that range
3440                                  # relate to getting make_patchnum.sh working,
3441                                  # so it is extremely unlikely to be an
3442                                  # interesting bisect target. They will skip.
3443
3444                                  # No, don't spawn a submake if
3445                                  # make_patchnum.sh or make_patchnum.pl fails
3446                                  $code =~ s{\|\| \$\(MAKE\) miniperl.*}
3447                                            {}m;
3448                                  $code =~ s{^\t(sh.*make_patchnum\.sh.*)}
3449                                            {\t-$1}m;
3450
3451                                  # Use an external perl to run make_patchnum.pl
3452                                  # because miniperl still depends on
3453                                  # git_version.h
3454                                  $code =~ s{^\t.*make_patchnum\.pl}
3455                                            {\t-$^X make_patchnum.pl}m;
3456
3457
3458                                  # "Truth in advertising" - running
3459                                  # make_patchnum generates 2 files.
3460                                  $code =~ s{^make_patchnum:.*}{
3461make_patchnum: lib/Config_git.pl
3462
3463git_version.h: lib/Config_git.pl
3464
3465perlmini\$(OBJ_EXT): git_version.h
3466
3467lib/Config_git.pl:}m;
3468                              }
3469                              # Right, now we've corrected Makefile.SH to
3470                              # correctly describe how lib/Config_git.pl and
3471                              # git_version.h are made, we need to fix the rest
3472
3473                              # This emulates commit 2b63e250843b907e
3474                              # This might duplicate the rule stating that
3475                              # git_version.h depends on lib/Config_git.pl
3476                              # This is harmless.
3477                              $code =~ s{^(?:lib/Config_git\.pl )?git_version\.h: (.* make_patchnum\.pl.*)}
3478                                        {git_version.h: lib/Config_git.pl
3479
3480lib/Config_git.pl: $1}m;
3481
3482                              # This emulates commits 0f13ebd5d71f8177
3483                              # and a04d4598adc57886. It ensures that
3484                              # lib/Config_git.pl is built before configpm,
3485                              # and that configpm is run exactly once.
3486                              $code =~ s{^(\$\(.*?\) )?(\$\(CONFIGPOD\))(: .*? configpm Porting/Glossary)( lib/Config_git\.pl)?}{
3487                                  # If present, other files depend on $(CONFIGPOD)
3488                                  ($1 ? "$1: $2\n\n" : '')
3489                                      # Then the rule we found
3490                                      . $2 . $3
3491                                          # Add dependency if not there
3492                                          . ($4 ? $4 : ' lib/Config_git.pl')
3493                              }me;
3494
3495                              return $code;
3496                          });
3497            }
3498        }
3499
3500        if ($major < 14) {
3501            # Commits dc0655f797469c47 and d11a62fe01f2ecb2
3502            edit_file('Makefile.SH', sub {
3503                          my $code = shift;
3504                          foreach my $ext (qw(Encode SDBM_File)) {
3505                              next if $code =~ /\b$ext\) extra_dep=/s;
3506                              $code =~ s!(\) extra_dep="\$extra_dep
3507\$this_target: .*?" ;;)
3508(    esac
3509)!$1
3510	$ext) extra_dep="\$extra_dep
3511\$this_target: lib/auto/Cwd/Cwd.\$dlext" ;;
3512$2!;
3513                          }
3514                          return $code;
3515                      });
3516        }
3517    }
3518
3519    if ($major == 3) {
3520        # This is part of commit f0efd8cf98c95b42:
3521        edit_file('Makefile.SH', sub {
3522                      my $code = shift;
3523                      $code =~ s/<<!NO!SUBS!/<<'!NO!SUBS!'/;
3524                      return $code;
3525                  });
3526    }
3527
3528    if ($major == 7) {
3529        # Remove commits 9fec149bb652b6e9 and 5bab1179608f81d8, which add/amend
3530        # rules to automatically run regen scripts that rebuild C headers. These
3531        # cause problems because a git checkout doesn't preserve relative file
3532        # modification times, hence the regen scripts may fire. This will
3533        # obscure whether the repository had the correct generated headers
3534        # checked in.
3535        # Also, the dependency rules for running the scripts were not correct,
3536        # which could cause spurious re-builds on re-running make, and can cause
3537        # complete build failures for a parallel make.
3538        if (extract_from_file('Makefile.SH',
3539                              qr/Writing it this way gives make a big hint to always run opcode\.pl before/)) {
3540            apply_commit('70c6e6715e8fec53');
3541        } elsif (extract_from_file('Makefile.SH',
3542                                   qr/^opcode\.h opnames\.h pp_proto\.h pp\.sym: opcode\.pl$/)) {
3543            revert_commit('9fec149bb652b6e9');
3544        }
3545    }
3546
3547    if ($^O eq 'darwin' && ($major < 8
3548                                || ($major < 10
3549                                    && !extract_from_file('ext/DynaLoader/Makefile.PL',
3550                                                          qr/sub MY::static /)))) {
3551        my $cwd = Cwd::getcwd();
3552        my $wrapper = 'miniperl.sh';
3553        my $fh = open_or_die($wrapper, '>');
3554        print $fh <<"EOT";
3555#!/bin/sh
3556${aggressive_apple_security}exec $cwd/miniperl "\$\@"
3557EOT
3558        close_or_die($fh);
3559        chmod 0755, $wrapper
3560            or die "Couldn't chmod 0755 $wrapper: $!";
3561
3562        edit_file('ext/util/make_ext', sub {
3563                      my $code = shift;
3564                      # This is shell expansion syntax
3565                      $code =~ s{ (\.\./\$depth/miniperl) }
3566                                { $1.sh };
3567                      # This is actually the same line as edited above.
3568                      # We need this because (yay), without this EU::MM will
3569                      # default to searching for a working perl binary
3570                      # (sensible plan) but due to macOS stripping
3571                      # DYLD_LIBRARY_PATH during system(...), .../miniperl
3572                      # (as found from $^X) *isn't* going to work.
3573                      $code =~ s{ (Makefile\.PL INSTALLDIRS=perl) }
3574                                { $1 PERL=\.\./\$depth/miniperl.sh };
3575                      return $code;
3576                  });
3577    }
3578
3579    if ($^O eq 'aix' && $major >= 8 && $major < 28
3580        && extract_from_file('Makefile.SH', qr!\Q./$(MINIPERLEXP) makedef.pl\E.*aix!)) {
3581        # This is a variant the AIX part of commit 72bbce3da5eeffde:
3582        # miniperl also needs -Ilib for perl.exp on AIX etc
3583        edit_file('Makefile.SH', sub {
3584                      my $code = shift;
3585                      $code =~ s{(\Q./$(MINIPERLEXP)\E) (makedef\.pl.*aix)}
3586                                {$1 -Ilib $2};
3587                      return $code;
3588                  })
3589    }
3590    # This is the line before the line we've edited just above:
3591    if ($^O eq 'aix' && $major >= 11 && $major <= 15
3592        && extract_from_file('makedef.pl', qr/^use Config/)) {
3593        edit_file('Makefile.SH', sub {
3594                      # The AIX part of commit e6807d8ab22b761c
3595                      # It's safe to substitute lib/Config.pm for config.sh
3596                      # as lib/Config.pm depends on config.sh
3597                      # If the tree is post e6807d8ab22b761c, the substitution
3598                      # won't match, which is harmless.
3599                      my $code = shift;
3600                      $code =~ s{^(perl\.exp:.* )config\.sh(\b.*)}
3601                                {$1 . '$(CONFIGPM)' . $2}me;
3602                      return $code;
3603                  });
3604    }
3605
3606    # There was a bug in makedepend.SH which was fixed in version 96a8704c.
3607    # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
3608    # Remove this if you're actually bisecting a problem related to
3609    # makedepend.SH
3610    # If you do this, you may need to add in code to correct the output of older
3611    # makedepends, which don't correctly filter newer gcc output such as
3612    # <built-in>
3613
3614    # It's the same version in v5.26.0 to v5.34.0
3615    # Post v5.34.0, commit 8d469d0ecbd06a99 completely changes how makedepend.SH
3616    # interacts with Makefile.SH, meaning that it's not a drop-in upgrade.
3617    checkout_file('makedepend.SH', 'v5.34.0')
3618        if $major < 26;
3619
3620    if ($major < 4 && -f 'config.sh'
3621        && !extract_from_file('config.sh', qr/^trnl=/)) {
3622        # This seems to be necessary to avoid makedepend becoming confused,
3623        # and hanging on stdin. Seems that the code after
3624        # make shlist || ...here... is never run.
3625        edit_file('makedepend.SH', sub {
3626                      my $code = shift;
3627                      $code =~ s/^trnl='\$trnl'$/trnl='\\n'/m;
3628                      return $code;
3629                  });
3630    }
3631}
3632
3633sub patch_C {
3634    # This is ordered by $major, as it's likely that different platforms may
3635    # well want to share code.
3636
3637    if ($major == 0) {
3638        apply_patch(<<'EOPATCH');
3639diff --git a/proto.h b/proto.h
3640index 9ffc6bbabc..16da198342 100644
3641--- a/proto.h
3642+++ b/proto.h
3643@@ -8,6 +8,7 @@
3644 #endif
3645 #ifdef OVERLOAD
3646 SV*	amagic_call _((SV* left,SV* right,int method,int dir));
3647+bool Gv_AMupdate _((HV* stash));
3648 #endif /* OVERLOAD */
3649 OP*	append_elem _((I32 optype, OP* head, OP* tail));
3650 OP*	append_list _((I32 optype, LISTOP* first, LISTOP* last));
3651EOPATCH
3652    }
3653
3654    if ($major == 2 && extract_from_file('perl.c', qr/^\tfclose\(e_fp\);$/)) {
3655        # need to patch perl.c to avoid calling fclose() twice on e_fp when
3656        # using -e
3657        # This diff is part of commit ab821d7fdc14a438. The second close was
3658        # introduced with perl-5.002, commit a5f75d667838e8e7
3659        # Might want a6c477ed8d4864e6 too, for the corresponding change to
3660        # pp_ctl.c (likely without this, eval will have "fun")
3661        apply_patch(<<'EOPATCH');
3662diff --git a/perl.c b/perl.c
3663index 03c4d48..3c814a2 100644
3664--- a/perl.c
3665+++ b/perl.c
3666@@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
3667 #ifndef VMS  /* VMS doesn't have environ array */
3668     origenviron = environ;
3669 #endif
3670+    e_tmpname = Nullch;
3671
3672     if (do_undump) {
3673
3674@@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
3675     if (e_fp) {
3676 	if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
3677 	    croak("Can't write to temp file for -e: %s", Strerror(errno));
3678+	e_fp = Nullfp;
3679 	argc++,argv--;
3680 	scriptname = e_tmpname;
3681     }
3682@@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
3683     curcop->cop_line = 0;
3684     curstash = defstash;
3685     preprocess = FALSE;
3686-    if (e_fp) {
3687-	fclose(e_fp);
3688-	e_fp = Nullfp;
3689+    if (e_tmpname) {
3690 	(void)UNLINK(e_tmpname);
3691+	Safefree(e_tmpname);
3692+	e_tmpname = Nullch;
3693     }
3694
3695     /* now that script is parsed, we can modify record separator */
3696@@ -1369,7 +1371,7 @@ SV *sv;
3697 	scriptname = xfound;
3698     }
3699
3700-    origfilename = savepv(e_fp ? "-e" : scriptname);
3701+    origfilename = savepv(e_tmpname ? "-e" : scriptname);
3702     curcop->cop_filegv = gv_fetchfile(origfilename);
3703     if (strEQ(origfilename,"-"))
3704 	scriptname = "";
3705
3706EOPATCH
3707    }
3708
3709    if ($major < 3 && $^O eq 'openbsd'
3710        && !extract_from_file('pp_sys.c', qr/BSD_GETPGRP/)) {
3711        # Part of commit c3293030fd1b7489
3712        apply_patch(<<'EOPATCH');
3713diff --git a/pp_sys.c b/pp_sys.c
3714index 4608a2a..f0c9d1d 100644
3715--- a/pp_sys.c
3716+++ b/pp_sys.c
3717@@ -2903,8 +2903,8 @@ PP(pp_getpgrp)
3718 	pid = 0;
3719     else
3720 	pid = SvIVx(POPs);
3721-#ifdef USE_BSDPGRP
3722-    value = (I32)getpgrp(pid);
3723+#ifdef BSD_GETPGRP
3724+    value = (I32)BSD_GETPGRP(pid);
3725 #else
3726     if (pid != 0)
3727 	DIE("POSIX getpgrp can't take an argument");
3728@@ -2933,8 +2933,8 @@ PP(pp_setpgrp)
3729     }
3730
3731     TAINT_PROPER("setpgrp");
3732-#ifdef USE_BSDPGRP
3733-    SETi( setpgrp(pid, pgrp) >= 0 );
3734+#ifdef BSD_SETPGRP
3735+    SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
3736 #else
3737     if ((pgrp != 0) || (pid != 0)) {
3738 	DIE("POSIX setpgrp can't take an argument");
3739EOPATCH
3740    }
3741
3742    # _(( was the macro wrapper for hiding ANSI prototypes from K&R C compilers:
3743    if ($major == 3 && !extract_from_file('proto.h', qr/\bsafemalloc\s+_\(\(/)) {
3744        # This is part of commit bbce6d69784bf43b:
3745        # [inseparable changes from patch from perl5.003_08 to perl5.003_09]
3746        # This only affects a few versions, but without this safemalloc etc get
3747        # an implicit return type (of int), and that is truncating addresses on
3748        # 64 bit systems. (And these days, seems that x86_64 linux has a memory
3749        # map which causes malloc to return addresses >= 2**32)
3750        apply_patch(<<'EOPATCH');
3751diff --git a/proto.h b/proto.h
3752index 851567b340..e650c8b07d 100644
3753--- a/proto.h
3754+++ b/proto.h
3755@@ -479,6 +479,13 @@ Malloc_t realloc _((Malloc_t where, MEM_SIZE nbytes));
3756 Free_t   free _((Malloc_t where));
3757 #endif
3758
3759+#ifndef MYMALLOC
3760+Malloc_t safemalloc _((MEM_SIZE nbytes));
3761+Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size));
3762+Malloc_t saferealloc _((Malloc_t where, MEM_SIZE nbytes));
3763+Free_t   safefree _((Malloc_t where));
3764+#endif
3765+
3766 #ifdef LEAKTEST
3767 Malloc_t safexmalloc _((I32 x, MEM_SIZE size));
3768 Malloc_t safexcalloc _((I32 x, MEM_SIZE elements, MEM_SIZE size));
3769EOPATCH
3770    }
3771
3772    if ($major < 4 && $^O eq 'openbsd') {
3773        my $bad;
3774        # Need changes from commit a6e633defa583ad5.
3775        # Commits c07a80fdfe3926b5 and f82b3d4130164d5f changed the same part
3776        # of perl.h
3777
3778        if (extract_from_file('perl.h',
3779                              qr/^#ifdef HAS_GETPGRP2$/)) {
3780            $bad = <<'EOBAD';
3781***************
3782*** 57,71 ****
3783  #define TAINT_PROPER(s)	if (tainting) taint_proper(no_security, s)
3784  #define TAINT_ENV()	if (tainting) taint_env()
3785
3786! #ifdef HAS_GETPGRP2
3787! #   ifndef HAS_GETPGRP
3788! #	define HAS_GETPGRP
3789! #   endif
3790! #endif
3791!
3792! #ifdef HAS_SETPGRP2
3793! #   ifndef HAS_SETPGRP
3794! #	define HAS_SETPGRP
3795! #   endif
3796  #endif
3797
3798EOBAD
3799        } elsif (extract_from_file('perl.h',
3800                                   qr/Gack, you have one but not both of getpgrp2/)) {
3801            $bad = <<'EOBAD';
3802***************
3803*** 56,76 ****
3804  #define TAINT_PROPER(s)	if (tainting) taint_proper(no_security, s)
3805  #define TAINT_ENV()	if (tainting) taint_env()
3806
3807! #if defined(HAS_GETPGRP2) && defined(HAS_SETPGRP2)
3808! #   define getpgrp getpgrp2
3809! #   define setpgrp setpgrp2
3810! #   ifndef HAS_GETPGRP
3811! #	define HAS_GETPGRP
3812! #   endif
3813! #   ifndef HAS_SETPGRP
3814! #	define HAS_SETPGRP
3815! #   endif
3816! #   ifndef USE_BSDPGRP
3817! #	define USE_BSDPGRP
3818! #   endif
3819! #else
3820! #   if defined(HAS_GETPGRP2) || defined(HAS_SETPGRP2)
3821! 	#include "Gack, you have one but not both of getpgrp2() and setpgrp2()."
3822! #   endif
3823  #endif
3824
3825EOBAD
3826        } elsif (extract_from_file('perl.h',
3827                                   qr/^#ifdef USE_BSDPGRP$/)) {
3828            $bad = <<'EOBAD'
3829***************
3830*** 91,116 ****
3831  #define TAINT_PROPER(s)	if (tainting) taint_proper(no_security, s)
3832  #define TAINT_ENV()	if (tainting) taint_env()
3833
3834! #ifdef USE_BSDPGRP
3835! #   ifdef HAS_GETPGRP
3836! #       define BSD_GETPGRP(pid) getpgrp((pid))
3837! #   endif
3838! #   ifdef HAS_SETPGRP
3839! #       define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
3840! #   endif
3841! #else
3842! #   ifdef HAS_GETPGRP2
3843! #       define BSD_GETPGRP(pid) getpgrp2((pid))
3844! #       ifndef HAS_GETPGRP
3845! #    	    define HAS_GETPGRP
3846! #    	endif
3847! #   endif
3848! #   ifdef HAS_SETPGRP2
3849! #       define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
3850! #       ifndef HAS_SETPGRP
3851! #    	    define HAS_SETPGRP
3852! #    	endif
3853! #   endif
3854  #endif
3855
3856  #ifndef _TYPES_		/* If types.h defines this it's easy. */
3857EOBAD
3858        }
3859        if ($bad) {
3860            apply_patch(<<"EOPATCH");
3861*** a/perl.h	2011-10-21 09:46:12.000000000 +0200
3862--- b/perl.h	2011-10-21 09:46:12.000000000 +0200
3863$bad--- 91,144 ----
3864  #define TAINT_PROPER(s)	if (tainting) taint_proper(no_security, s)
3865  #define TAINT_ENV()	if (tainting) taint_env()
3866
3867! /* XXX All process group stuff is handled in pp_sys.c.  Should these
3868!    defines move there?  If so, I could simplify this a lot. --AD  9/96.
3869! */
3870! /* Process group stuff changed from traditional BSD to POSIX.
3871!    perlfunc.pod documents the traditional BSD-style syntax, so we'll
3872!    try to preserve that, if possible.
3873! */
3874! #ifdef HAS_SETPGID
3875! #  define BSD_SETPGRP(pid, pgrp)	setpgid((pid), (pgrp))
3876! #else
3877! #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
3878! #    define BSD_SETPGRP(pid, pgrp)	setpgrp((pid), (pgrp))
3879! #  else
3880! #    ifdef HAS_SETPGRP2  /* DG/UX */
3881! #      define BSD_SETPGRP(pid, pgrp)	setpgrp2((pid), (pgrp))
3882! #    endif
3883! #  endif
3884! #endif
3885! #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
3886! #  define HAS_SETPGRP  /* Well, effectively it does . . . */
3887! #endif
3888!
3889! /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
3890!     our life easier :-) so we'll try it.
3891! */
3892! #ifdef HAS_GETPGID
3893! #  define BSD_GETPGRP(pid)		getpgid((pid))
3894! #else
3895! #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
3896! #    define BSD_GETPGRP(pid)		getpgrp((pid))
3897! #  else
3898! #    ifdef HAS_GETPGRP2  /* DG/UX */
3899! #      define BSD_GETPGRP(pid)		getpgrp2((pid))
3900! #    endif
3901! #  endif
3902! #endif
3903! #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
3904! #  define HAS_GETPGRP  /* Well, effectively it does . . . */
3905! #endif
3906!
3907! /* These are not exact synonyms, since setpgrp() and getpgrp() may
3908!    have different behaviors, but perl.h used to define USE_BSDPGRP
3909!    (prior to 5.003_05) so some extension might depend on it.
3910! */
3911! #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
3912! #  ifndef USE_BSDPGRP
3913! #    define USE_BSDPGRP
3914! #  endif
3915  #endif
3916
3917  #ifndef _TYPES_		/* If types.h defines this it's easy. */
3918EOPATCH
3919        }
3920    }
3921
3922    if ($major < 4 && $^O eq 'hpux'
3923        && extract_from_file('sv.c', qr/i = _filbuf\(/)) {
3924            apply_patch(<<'EOPATCH');
3925diff --git a/sv.c b/sv.c
3926index a1f1d60..0a806f1 100644
3927--- a/sv.c
3928+++ b/sv.c
3929@@ -2641,7 +2641,7 @@ I32 append;
3930
3931 	FILE_cnt(fp) = cnt;		/* deregisterize cnt and ptr */
3932 	FILE_ptr(fp) = ptr;
3933-	i = _filbuf(fp);		/* get more characters */
3934+	i = __filbuf(fp);		/* get more characters */
3935 	cnt = FILE_cnt(fp);
3936 	ptr = FILE_ptr(fp);		/* reregisterize cnt and ptr */
3937
3938
3939EOPATCH
3940    }
3941
3942    if ($major == 4 && extract_from_file('scope.c', qr/\(SV\*\)SSPOPINT/)) {
3943        # [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void)
3944        # Fixes a bug introduced in 161b7d1635bc830b
3945        apply_commit('9002cb76ec83ef7f');
3946    }
3947
3948    if ($major == 4 && extract_from_file('av.c', qr/AvARRAY\(av\) = 0;/)) {
3949        # Fixes a bug introduced in 1393e20655efb4bc
3950        apply_commit('e1c148c28bf3335b', 'av.c');
3951    }
3952
3953    if ($major == 4) {
3954        my $rest = extract_from_file('perl.c', qr/delimcpy(.*)/);
3955        if (defined $rest and $rest !~ /,$/) {
3956            # delimcpy added in fc36a67e8855d031, perl.c refactored to use it.
3957            # bug introduced in 2a92aaa05aa1acbf, fixed in 8490252049bf42d3
3958            # code then moved to util.c in commit 491527d0220de34e
3959            apply_patch(<<'EOPATCH');
3960diff --git a/perl.c b/perl.c
3961index 4eb69e3..54bbb00 100644
3962--- a/perl.c
3963+++ b/perl.c
3964@@ -1735,7 +1735,7 @@ SV *sv;
3965 	    if (len < sizeof tokenbuf)
3966 		tokenbuf[len] = '\0';
3967 #else	/* ! (atarist || DOSISH) */
3968-	    s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend
3969+	    s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
3970 			 ':',
3971 			 &len);
3972 #endif	/* ! (atarist || DOSISH) */
3973EOPATCH
3974        }
3975    }
3976
3977    if ($major == 4 && $^O eq 'linux') {
3978        # Whilst this is fixed properly in f0784f6a4c3e45e1 which provides the
3979        # Configure probe, it's easier to back out the problematic changes made
3980        # in these previous commits.
3981
3982        # In maint-5.004, the simplest addition is to "correct" the file to
3983        # use the same pre-processor macros as blead had used. Whilst commit
3984        # 9b599b2a63d2324d (reverted below) is described as
3985        # [win32] merge change#887 from maintbranch
3986        # it uses __sun__ and __svr4__ instead of the __sun and __SVR4 of the
3987        # maint branch commit 6cdf74fe31f049dc
3988
3989        edit_file('doio.c', sub {
3990                      my $code = shift;
3991                      $code =~ s{defined\(__sun\) && defined\(__SVR4\)}
3992                                {defined(__sun__) && defined(__svr4__)}g;
3993                      return $code;
3994                  });
3995
3996        if (extract_from_file('doio.c',
3997                              qr!^/\* XXX REALLY need metaconfig test \*/$!)) {
3998            revert_commit('4682965a1447ea44', 'doio.c');
3999        }
4000        if (my $token = extract_from_file('doio.c',
4001                                          qr!^#if (defined\(__sun(?:__)?\)) && defined\(__svr4__\) /\* XXX Need metaconfig test \*/$!)) {
4002            my $patch = patch_from_commit('revert', '9b599b2a63d2324d', 'doio.c');
4003            $patch =~ s/defined\(__sun__\)/$token/g;
4004            apply_patch($patch);
4005        }
4006        if (extract_from_file('doio.c',
4007                              qr!^/\* linux \(and Solaris2\?\) uses :$!)) {
4008            revert_commit('8490252049bf42d3', 'doio.c');
4009        }
4010        if (extract_from_file('doio.c',
4011                              qr/^	    unsemds.buf = &semds;$/)) {
4012            revert_commit('8e591e46b4c6543e');
4013        }
4014        if (extract_from_file('doio.c',
4015                              qr!^#ifdef __linux__	/\* XXX Need metaconfig test \*/$!)) {
4016            # Reverts part of commit 3e3baf6d63945cb6
4017            apply_patch(<<'EOPATCH');
4018diff --git b/doio.c a/doio.c
4019index 62b7de9..0d57425 100644
4020--- b/doio.c
4021+++ a/doio.c
4022@@ -1333,9 +1331,6 @@ SV **sp;
4023     char *a;
4024     I32 id, n, cmd, infosize, getinfo;
4025     I32 ret = -1;
4026-#ifdef __linux__	/* XXX Need metaconfig test */
4027-    union semun unsemds;
4028-#endif
4029
4030     id = SvIVx(*++mark);
4031     n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
4032@@ -1364,29 +1359,11 @@ SV **sp;
4033 	    infosize = sizeof(struct semid_ds);
4034 	else if (cmd == GETALL || cmd == SETALL)
4035 	{
4036-#ifdef __linux__	/* XXX Need metaconfig test */
4037-/* linux uses :
4038-   int semctl (int semid, int semnun, int cmd, union semun arg)
4039-
4040-       union semun {
4041-            int val;
4042-            struct semid_ds *buf;
4043-            ushort *array;
4044-       };
4045-*/
4046-            union semun semds;
4047-	    if (semctl(id, 0, IPC_STAT, semds) == -1)
4048-#else
4049 	    struct semid_ds semds;
4050 	    if (semctl(id, 0, IPC_STAT, &semds) == -1)
4051-#endif
4052 		return -1;
4053 	    getinfo = (cmd == GETALL);
4054-#ifdef __linux__	/* XXX Need metaconfig test */
4055-	    infosize = semds.buf->sem_nsems * sizeof(short);
4056-#else
4057 	    infosize = semds.sem_nsems * sizeof(short);
4058-#endif
4059 		/* "short" is technically wrong but much more portable
4060 		   than guessing about u_?short(_t)? */
4061 	}
4062@@ -1429,12 +1406,7 @@ SV **sp;
4063 #endif
4064 #ifdef HAS_SEM
4065     case OP_SEMCTL:
4066-#ifdef __linux__	/* XXX Need metaconfig test */
4067-        unsemds.buf = (struct semid_ds *)a;
4068-	ret = semctl(id, n, cmd, unsemds);
4069-#else
4070 	ret = semctl(id, n, cmd, (struct semid_ds *)a);
4071-#endif
4072 	break;
4073 #endif
4074 #ifdef HAS_SHM
4075EOPATCH
4076        }
4077        # Incorrect prototype added as part of 8ac853655d9b7447, fixed as part
4078        # of commit dc45a647708b6c54, with at least one intermediate
4079        # modification. Correct prototype for gethostbyaddr has socklen_t
4080        # second. Linux has uint32_t first for getnetbyaddr.
4081        # Easiest just to remove, instead of attempting more complex patching.
4082        # Something similar may be needed on other platforms.
4083        edit_file('pp_sys.c', sub {
4084                      my $code = shift;
4085                      $code =~ s/^    struct hostent \*(?:PerlSock_)?gethostbyaddr\([^)]+\);$//m;
4086                      $code =~ s/^    struct netent \*getnetbyaddr\([^)]+\);$//m;
4087                      return $code;
4088                  });
4089    }
4090
4091    if ($major < 5 && $^O eq 'aix'
4092        && !extract_from_file('pp_sys.c',
4093                              qr/defined\(HOST_NOT_FOUND\) && !defined\(h_errno\)/)) {
4094        # part of commit dc45a647708b6c54
4095        # Andy Dougherty's configuration patches (Config_63-01 up to 04).
4096        apply_patch(<<'EOPATCH')
4097diff --git a/pp_sys.c b/pp_sys.c
4098index c2fcb6f..efa39fb 100644
4099--- a/pp_sys.c
4100+++ b/pp_sys.c
4101@@ -54,7 +54,7 @@ extern "C" int syscall(unsigned long,...);
4102 #endif
4103 #endif
4104
4105-#ifdef HOST_NOT_FOUND
4106+#if defined(HOST_NOT_FOUND) && !defined(h_errno)
4107 extern int h_errno;
4108 #endif
4109
4110EOPATCH
4111    }
4112
4113    if ($major == 5
4114        && `git rev-parse HEAD` eq "22c35a8c2392967a5ba6b5370695be464bd7012c\n") {
4115        # Commit 22c35a8c2392967a is significant,
4116        # "phase 1 of somewhat major rearrangement of PERL_OBJECT stuff"
4117        # but doesn't build due to 2 simple errors. blead in this broken state
4118        # was merged to the cfgperl branch, and then these were immediately
4119        # corrected there. cfgperl (with the fixes) was merged back to blead.
4120        # The resultant rather twisty maze of commits looks like this:
4121
4122=begin comment
4123
4124* | |   commit 137225782c183172f360c827424b9b9f8adbef0e
4125|\ \ \  Merge: 22c35a8 2a8ee23
4126| |/ /  Author: Gurusamy Sarathy <gsar@cpan.org>
4127| | |   Date:   Fri Oct 30 17:38:36 1998 +0000
4128| | |
4129| | |       integrate cfgperl tweaks into mainline
4130| | |
4131| | |       p4raw-id: //depot/perl@2144
4132| | |
4133| * | commit 2a8ee23279873759693fa83eca279355db2b665c
4134| | | Author: Jarkko Hietaniemi <jhi@iki.fi>
4135| | | Date:   Fri Oct 30 13:27:39 1998 +0000
4136| | |
4137| | |     There can be multiple yacc/bison errors.
4138| | |
4139| | |     p4raw-id: //depot/cfgperl@2143
4140| | |
4141| * | commit 93fb2ac393172fc3e2c14edb20b718309198abbc
4142| | | Author: Jarkko Hietaniemi <jhi@iki.fi>
4143| | | Date:   Fri Oct 30 13:18:43 1998 +0000
4144| | |
4145| | |     README.posix-bc update.
4146| | |
4147| | |     p4raw-id: //depot/cfgperl@2142
4148| | |
4149| * | commit 4ec43091e8e6657cb260b5e563df30aaa154effe
4150| | | Author: Jarkko Hietaniemi <jhi@iki.fi>
4151| | | Date:   Fri Oct 30 09:12:59 1998 +0000
4152| | |
4153| | |     #2133 fallout.
4154| | |
4155| | |     p4raw-id: //depot/cfgperl@2141
4156| | |
4157| * |   commit 134ca994cfefe0f613d43505a885e4fc2100b05c
4158| |\ \  Merge: 7093112 22c35a8
4159| |/ /  Author: Jarkko Hietaniemi <jhi@iki.fi>
4160|/| |   Date:   Fri Oct 30 08:43:18 1998 +0000
4161| | |
4162| | |       Integrate from mainperl.
4163| | |
4164| | |       p4raw-id: //depot/cfgperl@2140
4165| | |
4166* | | commit 22c35a8c2392967a5ba6b5370695be464bd7012c
4167| | | Author: Gurusamy Sarathy <gsar@cpan.org>
4168| | | Date:   Fri Oct 30 02:51:39 1998 +0000
4169| | |
4170| | |     phase 1 of somewhat major rearrangement of PERL_OBJECT stuff
4171| | |     (objpp.h is gone, embed.pl now does some of that); objXSUB.h
4172| | |     should soon be automated also; the global variables that
4173| | |     escaped the PL_foo conversion are now reined in; renamed
4174| | |     MAGIC in regcomp.h to REG_MAGIC to avoid collision with the
4175| | |     type of same name; duplicated lists of pp_things in various
4176| | |     places is now gone; result has only been tested on win32
4177| | |
4178| | |     p4raw-id: //depot/perl@2133
4179
4180=end comment
4181
4182=cut
4183
4184        # and completely confuses git bisect (and at least me), causing it to
4185        # the bisect run to confidently return the wrong answer, an unrelated
4186        # commit on the cfgperl branch.
4187
4188        apply_commit('4ec43091e8e6657c');
4189    }
4190
4191    if ($major == 5
4192        && extract_from_file('pp_sys.c', qr/PERL_EFF_ACCESS_R_OK/)
4193        && !extract_from_file('pp_sys.c', qr/XXX Configure test needed for eaccess/)) {
4194        # Between 5ff3f7a4e03a6b10 and c955f1177b2e311d^
4195        # This is the meat of commit c955f1177b2e311d (without the other
4196        # indenting changes that would cause a conflict).
4197        # Without this 538 revisions won't build on (at least) Linux
4198        apply_patch(<<'EOPATCH');
4199diff --git a/pp_sys.c b/pp_sys.c
4200index d60c8dc..867dee4 100644
4201--- a/pp_sys.c
4202+++ b/pp_sys.c
4203@@ -198,9 +198,18 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
4204 #   if defined(I_SYS_SECURITY)
4205 #       include <sys/security.h>
4206 #   endif
4207-#   define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
4208-#   define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
4209-#   define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
4210+    /* XXX Configure test needed for eaccess */
4211+#   ifdef ACC_SELF
4212+        /* HP SecureWare */
4213+#       define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
4214+#       define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
4215+#       define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
4216+#   else
4217+        /* SCO */
4218+#       define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK))
4219+#       define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK))
4220+#       define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK))
4221+#   endif
4222 #endif
4223
4224 #if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF)
4225EOPATCH
4226    }
4227
4228    if ($major == 5
4229        && extract_from_file('mg.c', qr/If we're still on top of the stack, pop us off/)
4230        && !extract_from_file('mg.c', qr/PL_savestack_ix -= popval/)) {
4231        # Fix up commit 455ece5e082708b1:
4232        # SSNEW() API for allocating memory on the savestack
4233        # Message-Id: <tqemtae338.fsf@puma.genscan.com>
4234        # Subject: [PATCH 5.005_51] (was: why SAVEDESTRUCTOR()...)
4235        apply_commit('3c8a44569607336e', 'mg.c');
4236    }
4237
4238    if ($major == 5) {
4239        if (extract_from_file('doop.c', qr/croak\(no_modify\);/)
4240            && extract_from_file('doop.c', qr/croak\(PL_no_modify\);/)) {
4241            # Whilst the log suggests that this would only fix 5 commits, in
4242            # practice this area of history is a complete tarpit, and git bisect
4243            # gets very confused by the skips in the middle of the back and
4244            # forth merging between //depot/perl and //depot/cfgperl
4245            apply_commit('6393042b638dafd3');
4246        }
4247
4248        # One error "fixed" with another:
4249        if (extract_from_file('pp_ctl.c',
4250                              qr/\Qstatic void *docatch_body _((void *o));\E/)) {
4251            apply_commit('5b51e982882955fe');
4252        }
4253        # Which is then fixed by this:
4254        if (extract_from_file('pp_ctl.c',
4255                              qr/\Qstatic void *docatch_body _((valist\E/)) {
4256            apply_commit('47aa779ee4c1a50e');
4257        }
4258
4259        if (extract_from_file('thrdvar.h', qr/PERLVARI\(Tprotect/)
4260            && !extract_from_file('embedvar.h', qr/PL_protect/)) {
4261            # Commit 312caa8e97f1c7ee didn't update embedvar.h
4262            apply_commit('e0284a306d2de082', 'embedvar.h');
4263        }
4264    }
4265
4266    if ($major == 5
4267        && extract_from_file('sv.c',
4268                             qr/PerlDir_close\(IoDIRP\((?:\(IO\*\))?sv\)\);/)
4269        && !(extract_from_file('toke.c',
4270                               qr/\QIoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL\E/)
4271             || extract_from_file('toke.c',
4272                                  qr/\QIoDIRP(datasv) = (DIR*)NULL;\E/))) {
4273        # Commit 93578b34124e8a3b, //depot/perl@3298
4274        # close directory handles properly when localized,
4275        # tweaked slightly by commit 1236053a2c722e2b,
4276        # add test case for change#3298
4277        #
4278        # The fix is the last part of:
4279        #
4280        # various fixes for clean build and test on win32; configpm broken,
4281        # needed to open myconfig.SH rather than myconfig; sundry adjustments
4282        # to bytecode stuff; tweaks to DYNAMIC_ENV_FETCH code to make it
4283        # work under win32; getenv_sv() changed to getenv_len() since SVs
4284        # aren't visible in the lower echelons; remove bogus exports from
4285        # config.sym; PERL_OBJECT-ness for C++ exception support; null out
4286        # IoDIRP in filter_del() or sv_free() will attempt to close it
4287        #
4288        # The changed code is modified subsequently by commit e0c198038146b7a4
4289        apply_commit('a6c403648ecd5cc7', 'toke.c');
4290    }
4291
4292    if ($major < 6 && $^O eq 'netbsd'
4293        && !extract_from_file('unixish.h',
4294                              qr/defined\(NSIG\).*defined\(__NetBSD__\)/)) {
4295        apply_patch(<<'EOPATCH')
4296diff --git a/unixish.h b/unixish.h
4297index 2a6cbcd..eab2de1 100644
4298--- a/unixish.h
4299+++ b/unixish.h
4300@@ -89,7 +89,7 @@
4301  */
4302 /* #define ALTERNATE_SHEBANG "#!" / **/
4303
4304-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
4305+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
4306 # include <signal.h>
4307 #endif
4308
4309EOPATCH
4310    }
4311
4312    if ($major < 6 && extract_from_file('perl.h', qr/PL_uuemap\[\]/)) {
4313        # That [] needs to be [65]:
4314        apply_commit('7575fa06ca7baf15');
4315    }
4316
4317    if ($major < 6 && $^O eq 'darwin'
4318            && !extract_from_file('perl.h', qr/ifdef I_FCNTL/)) {
4319        # This is part of commit 9a34ef1dede5fef4, but in a stable part of the
4320        # file:
4321        apply_patch(<<'EOPATCH')
4322diff --git a/perl.h b/perl.h
4323index 0d3f0b8333..19f6684894 100644
4324--- a/perl.h
4325+++ b/perl.h
4326@@ -310,6 +310,14 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
4327 #   define BYTEORDER 0x1234
4328 #endif
4329
4330+#ifdef I_FCNTL
4331+#  include <fcntl.h>
4332+#endif
4333+
4334+#ifdef I_SYS_FILE
4335+#  include <sys/file.h>
4336+#endif
4337+
4338 /* Overall memory policy? */
4339 #ifndef CONSERVATIVE
4340 #   define LIBERAL 1
4341EOPATCH
4342    }
4343
4344    if ($major == 7 && $^O eq 'aix' && -f 'ext/List/Util/Util.xs'
4345        && extract_from_file('ext/List/Util/Util.xs', qr/PUSHBLOCK/)
4346        && !extract_from_file('makedef.pl', qr/^Perl_cxinc/)) {
4347        # Need this to get List::Utils 1.03 and later to compile.
4348        # 1.03 also expects to call Perl_pp_rand. Commit d3632a54487acc5f
4349        # fixes this (for the unthreaded case), but it's not until 1.05,
4350        # two days later, that this is fixed properly.
4351        apply_commit('cbb96eed3f175499');
4352    }
4353
4354    if (($major >= 7 || $major <= 9) && $^O eq 'openbsd'
4355        && `uname -m` eq "sparc64\n"
4356        # added in 2000 by commit cb434fcc98ac25f5:
4357        && extract_from_file('regexec.c',
4358                             qr!/\* No need to save/restore up to this paren \*/!)
4359        # re-indented in 2006 by commit 95b2444054382532:
4360        && extract_from_file('regexec.c', qr/^\t\tCURCUR cc;$/)) {
4361        # Need to work around a bug in (at least) OpenBSD's 4.6's sparc64 #
4362        # compiler ["gcc (GCC) 3.3.5 (propolice)"]. Between commits
4363        # 3ec562b0bffb8b8b (2002) and 1a4fad37125bac3e^ (2005) the darling thing
4364        # fails to compile any code for the statement cc.oldcc = PL_regcc;
4365        #
4366        # If you refactor the code to "fix" that, or force the issue using set
4367        # in the debugger, the stack smashing detection code fires on return
4368        # from S_regmatch(). Turns out that the compiler doesn't allocate any
4369        # (or at least enough) space for cc.
4370        #
4371        # Restore the "uninitialised" value for cc before function exit, and the
4372        # stack smashing code is placated.  "Fix" 3ec562b0bffb8b8b (which
4373        # changes the size of auto variables used elsewhere in S_regmatch), and
4374        # the crash is visible back to bc517b45fdfb539b (which also changes
4375        # buffer sizes). "Unfix" 1a4fad37125bac3e and the crash is visible until
4376        # 5b47454deb66294b.  Problem goes away if you compile with -O, or hack
4377        # the code as below.
4378        #
4379        # Hence this turns out to be a bug in (old) gcc. Not a security bug we
4380        # still need to fix.
4381        apply_patch(<<'EOPATCH');
4382diff --git a/regexec.c b/regexec.c
4383index 900b491..6251a0b 100644
4384--- a/regexec.c
4385+++ b/regexec.c
4386@@ -2958,7 +2958,11 @@ S_regmatch(pTHX_ regnode *prog)
4387 				I,I
4388  *******************************************************************/
4389 	case CURLYX: {
4390-		CURCUR cc;
4391+	    union {
4392+		CURCUR hack_cc;
4393+		char hack_buff[sizeof(CURCUR) + 1];
4394+	    } hack;
4395+#define cc hack.hack_cc
4396 		CHECKPOINT cp = PL_savestack_ix;
4397 		/* No need to save/restore up to this paren */
4398 		I32 parenfloor = scan->flags;
4399@@ -2983,6 +2987,7 @@ S_regmatch(pTHX_ regnode *prog)
4400 		n = regmatch(PREVOPER(next));	/* start on the WHILEM */
4401 		regcpblow(cp);
4402 		PL_regcc = cc.oldcc;
4403+#undef cc
4404 		saySAME(n);
4405 	    }
4406 	    /* NOT REACHED */
4407EOPATCH
4408}
4409
4410    if ($major < 8 && !extract_from_file('perl.h', qr/\bshort htovs\b/)) {
4411        # This is part of commit c623ac675720b314
4412        apply_patch(<<'EOPATCH');
4413diff --git a/perl.h b/perl.h
4414index 023b90b7ea..59a21faecd 100644
4415--- a/perl.h
4416+++ b/perl.h
4417@@ -2279,4 +2279,8 @@ struct ptr_tbl {
4418 # endif
4419 	/* otherwise default to functions in util.c */
4420+short htovs(short n);
4421+short vtohs(short n);
4422+long htovl(long n);
4423+long vtohl(long n);
4424 #endif
4425
4426EOPATCH
4427    }
4428
4429    if ($major < 8 && !extract_from_file('perl.h', qr/include <unistd\.h>/)) {
4430        # This is part of commit 3f270f98f9305540, applied at a slightly
4431        # different location in perl.h, where the context is stable back to
4432        # 5.000
4433        apply_patch(<<'EOPATCH');
4434diff --git a/perl.h b/perl.h
4435index 9418b52..b8b1a7c 100644
4436--- a/perl.h
4437+++ b/perl.h
4438@@ -496,6 +496,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
4439 #   include <sys/param.h>
4440 #endif
4441
4442+/* If this causes problems, set i_unistd=undef in the hint file.  */
4443+#ifdef I_UNISTD
4444+#   include <unistd.h>
4445+#endif
4446
4447 /* Use all the "standard" definitions? */
4448 #if defined(STANDARD_C) && defined(I_STDLIB)
4449EOPATCH
4450    }
4451
4452    if ($major < 10) {
4453        # This is commit 731e259481f36b35, but adapted to remove all the
4454        # variations of guards around the inclusion of <signal.h>
4455        # Whilst we only hit this as a problem on arm64 macOS (so far), because
4456        # it insists on prototypes for everything, I'm assuming that doing this
4457        # everywhere and unconditionally might solve similar problems on other
4458        # platforms. Certainly, it *ought* to be safe to include a C89 header
4459        # these days.
4460        for my $file (qw(doop.c mg.c mpeix/mpeixish.h plan9/plan9ish.h unixish.h util.c)) {
4461            next
4462                unless -f $file;
4463            edit_file($file, sub {
4464                          my $code = shift;
4465                          $code =~ s{
4466                                        \n
4467                                        \#if \s+ [^\n]+
4468                                        \n
4469                                        \# \s* include \s+ <signal\.h>
4470                                        \n
4471                                        \#endif
4472                                        \n
4473                                }
4474                                    {\n#include <signal.h>\n}x;
4475                          return $code;
4476                      });
4477        }
4478    }
4479
4480    if ($major == 15) {
4481        # This affects a small range of commits around July 2011, but build
4482        # failures here get in the way of bisecting other problems:
4483
4484        my $line = extract_from_file('embed.fnc', qr/^X?pR\t\|I32\t\|was_lvalue_sub$/);
4485        if ($line) {
4486            # Need to export Perl_was_lvalue_sub:
4487            apply_commit('7b70e8177801df4e')
4488                unless $line =~ /X/;
4489
4490            # It needs to be 'ApR' not 'XpR', to be visible to List::Util
4491            # (arm64 macOS treats the missing prototypes as errors)
4492            apply_commit('c73b0699db4d0b8b');
4493        }
4494    }
4495}
4496
4497sub patch_ext {
4498    if (-f 'ext/POSIX/Makefile.PL'
4499        && extract_from_file('ext/POSIX/Makefile.PL',
4500                             qr/Explicitly avoid including/)) {
4501        # commit 6695a346c41138df, which effectively reverts 170888cff5e2ffb7
4502
4503        # PERL5LIB is populated by make_ext.pl with paths to the modules we need
4504        # to run, don't override this with "../../lib" since that may not have
4505        # been populated yet in a parallel build.
4506        apply_commit('6695a346c41138df');
4507    }
4508
4509    if (-f 'ext/Hash/Util/Makefile.PL'
4510        && extract_from_file('ext/Hash/Util/Makefile.PL',
4511                             qr/\bDIR\b.*'FieldHash'/)) {
4512        # ext/Hash/Util/Makefile.PL should not recurse to FieldHash's Makefile.PL
4513        # *nix, VMS and Win32 all know how to (and have to) call the latter directly.
4514        # As is, targets in ext/Hash/Util/FieldHash get called twice, which may result
4515        # in race conditions, and certainly messes up make clean; make distclean;
4516        apply_commit('550428fe486b1888');
4517    }
4518
4519    if ($major < 8 && $^O eq 'darwin' && !-f 'ext/DynaLoader/dl_dyld.xs') {
4520        checkout_file('ext/DynaLoader/dl_dyld.xs', 'f556e5b971932902');
4521        apply_patch(<<'EOPATCH');
4522diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
4523--- a/ext/DynaLoader/dl_dyld.xs	2011-10-11 21:41:27.000000000 +0100
4524+++ b/ext/DynaLoader/dl_dyld.xs	2011-10-11 21:42:20.000000000 +0100
4525@@ -41,6 +41,35 @@
4526 #include "perl.h"
4527 #include "XSUB.h"
4528
4529+#ifndef pTHX
4530+#  define pTHX		void
4531+#  define pTHX_
4532+#endif
4533+#ifndef aTHX
4534+#  define aTHX
4535+#  define aTHX_
4536+#endif
4537+#ifndef dTHX
4538+#  define dTHXa(a)	extern int Perl___notused(void)
4539+#  define dTHX		extern int Perl___notused(void)
4540+#endif
4541+
4542+#ifndef Perl_form_nocontext
4543+#  define Perl_form_nocontext form
4544+#endif
4545+
4546+#ifndef Perl_warn_nocontext
4547+#  define Perl_warn_nocontext warn
4548+#endif
4549+
4550+#ifndef PTR2IV
4551+#  define PTR2IV(p)	(IV)(p)
4552+#endif
4553+
4554+#ifndef get_av
4555+#  define get_av perl_get_av
4556+#endif
4557+
4558 #define DL_LOADONCEONLY
4559
4560 #include "dlutils.c"	/* SaveError() etc	*/
4561@@ -104,7 +145,7 @@
4562     dl_last_error = savepv(error);
4563 }
4564
4565-static char *dlopen(char *path, int mode /* mode is ignored */)
4566+static char *dlopen(char *path)
4567 {
4568     int dyld_result;
4569     NSObjectFileImage ofile;
4570@@ -161,13 +202,11 @@
4571 dl_load_file(filename, flags=0)
4572     char *	filename
4573     int		flags
4574-    PREINIT:
4575-    int mode = 1;
4576     CODE:
4577     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
4578     if (flags & 0x01)
4579-	Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
4580-    RETVAL = dlopen(filename, mode) ;
4581+	Perl_warn_nocontext("Can't make loaded symbols global on this platform while loading %s",filename);
4582+    RETVAL = dlopen(filename);
4583     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
4584     ST(0) = sv_newmortal() ;
4585     if (RETVAL == NULL)
4586EOPATCH
4587        if ($major < 4 && !extract_from_file('util.c', qr/^form/m)) {
4588            apply_patch(<<'EOPATCH');
4589diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
4590--- a/ext/DynaLoader/dl_dyld.xs	2011-10-11 21:56:25.000000000 +0100
4591+++ b/ext/DynaLoader/dl_dyld.xs	2011-10-11 22:00:00.000000000 +0100
4592@@ -60,6 +60,18 @@
4593 #  define get_av perl_get_av
4594 #endif
4595
4596+static char *
4597+form(char *pat, ...)
4598+{
4599+    char *retval;
4600+    va_list args;
4601+    va_start(args, pat);
4602+    vasprintf(&retval, pat, &args);
4603+    va_end(args);
4604+    SAVEFREEPV(retval);
4605+    return retval;
4606+}
4607+
4608 #define DL_LOADONCEONLY
4609
4610 #include "dlutils.c"	/* SaveError() etc	*/
4611EOPATCH
4612        }
4613    }
4614
4615    if ($major < 10) {
4616        if ($unfixable_db_file) {
4617            # Nothing we can do.
4618        } else {
4619            if (!extract_from_file('ext/DB_File/DB_File.xs',
4620                                   qr/^#ifdef AT_LEAST_DB_4_1$/)) {
4621                # This line is changed by commit 3245f0580c13b3ab
4622                my $line = extract_from_file('ext/DB_File/DB_File.xs',
4623                                             qr/^(        status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/);
4624                apply_patch(<<"EOPATCH");
4625diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
4626index 489ba96..fba8ded 100644
4627--- a/ext/DB_File/DB_File.xs
4628+++ b/ext/DB_File/DB_File.xs
4629\@\@ -183,4 +187,8 \@\@
4630 #endif
4631
4632+#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
4633+#    define AT_LEAST_DB_4_1
4634+#endif
4635+
4636 /* map version 2 features & constants onto their version 1 equivalent */
4637
4638\@\@ -1334,7 +1419,12 \@\@ SV *   sv ;
4639 #endif
4640
4641+#ifdef AT_LEAST_DB_4_1
4642+        status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
4643+	    			Flags, mode) ;
4644+#else
4645 $line
4646 	    			Flags, mode) ;
4647+#endif
4648 	/* printf("open returned %d %s\\n", status, db_strerror(status)) ; */
4649
4650EOPATCH
4651            }
4652
4653            if (!extract_from_file('ext/DB_File/DB_File.xs',
4654                                   qr/\bextern void __getBerkeleyDBInfo\b/)) {
4655                # A prototype for __getBerkeleyDBInfo();
4656                apply_commit('b92372bcedd4cbc4');
4657            }
4658        }
4659    }
4660
4661    if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') {
4662        edit_file('ext/IPC/SysV/SysV.xs', sub {
4663                      my $xs = shift;
4664                      my $fixed = <<'EOFIX';
4665
4666#include <sys/types.h>
4667#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
4668#ifndef HAS_SEM
4669#   include <sys/ipc.h>
4670#endif
4671#   ifdef HAS_MSG
4672#       include <sys/msg.h>
4673#   endif
4674#   ifdef HAS_SHM
4675#       if defined(PERL_SCO) || defined(PERL_ISC)
4676#           include <sys/sysmacros.h>	/* SHMLBA */
4677#       endif
4678#      include <sys/shm.h>
4679#      ifndef HAS_SHMAT_PROTOTYPE
4680           extern Shmat_t shmat (int, char *, int);
4681#      endif
4682#      if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
4683#          undef  SHMLBA /* not static: determined at boot time */
4684#          define SHMLBA sysconf(_SC_PAGESIZE)
4685#      elif defined(HAS_GETPAGESIZE)
4686#          undef  SHMLBA /* not static: determined at boot time */
4687#          define SHMLBA getpagesize()
4688#      endif
4689#   endif
4690#endif
4691EOFIX
4692                      $xs =~ s!
4693#include <sys/types\.h>
4694.*
4695(#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms;
4696                      return $xs;
4697                  });
4698    }
4699
4700    if ($major < 10 and -f 'ext/Digest/MD5/MD5.xs') {
4701        require Digest::MD5;
4702        my ($was, $now);
4703        # The edit to the XS is commit 9ee8e69ab2318ba3, but the testcase fixup
4704        # needs to work for several earlier commits.
4705        edit_file('ext/Digest/MD5/MD5.xs', sub {
4706                      my $xs = shift;
4707                      $was = Digest::MD5::md5_hex($xs);
4708                      $xs =~ s{\Q#if PATCHLEVEL <= 4 && !defined(PL_dowarn)}
4709                              {#if PERL_VERSION <= 4 && !defined(PL_dowarn)};
4710                      $now = Digest::MD5::md5_hex($xs);
4711                      return $xs;
4712                  });
4713
4714        edit_file('ext/Digest/MD5/t/files.t', sub {
4715                      my $testcase = shift;
4716                      $testcase =~ s/$was/$now/g;
4717                      return $testcase;
4718                  })
4719            if $was ne $now;
4720    }
4721
4722    if ($major >= 10 && $major < 20
4723            && !extract_from_file('ext/SDBM_File/Makefile.PL', qr/MY::subdir_x/)) {
4724        # Parallel make fix for SDBM_File
4725        # Technically this is needed for pre v5.10.0, but we don't attempt
4726        # parallel makes on earlier versions because it's unreliable due to
4727        # other bugs.
4728        # So far, only AIX make has come acropper on this bug.
4729        apply_commit('4d106cc5d8fd328d', 'ext/SDBM_File/Makefile.PL');
4730    }
4731
4732    if (-f 'ext/Errno/Errno_pm.PL') {
4733        if ($major < 22 && !extract_from_file('ext/Errno/Errno_pm.PL',
4734                                              qr/RT#123784/)) {
4735            my $gcc_major = extract_from_file('config.sh',
4736                                              qr/^gccversion='([0-9]+)\./,
4737                                              0);
4738            if ($gcc_major >= 5) {
4739                # This is the fix of commit 816b056ffb99ae54, but implemented in
4740                # a way that should work back to the earliest versions of Errno:
4741                edit_file('ext/Errno/Errno_pm.PL', sub {
4742                              my $code = shift;
4743                              $code =~ s/( \$Config\{cppflags\})/$1 -P/g;
4744                              return $code;
4745                          });
4746            }
4747        }
4748        if ($major < 8 && !extract_from_file('ext/Errno/Errno_pm.PL',
4749                                             qr/With the -dM option, gcc/)) {
4750            # This is the fix of commit 9ae2e8df64ee1443 re-ordered slightly so
4751            # that it should work back to the earliest versions of Errno:
4752            apply_patch(<<'EOPATCH');
4753diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL
4754index b669790314..c00d6c1a86 100644
4755--- a/ext/Errno/Errno_pm.PL
4756+++ b/ext/Errno/Errno_pm.PL
4757@@ -30,6 +30,12 @@ sub process_file {
4758             warn "Cannot open '$file'";
4759             return;
4760 	}
4761+    } elsif ($Config{gccversion} ne '') {
4762+	# With the -dM option, gcc outputs every #define it finds
4763+	unless(open(FH,"$Config{cc} -E -dM $file |")) {
4764+            warn "Cannot open '$file'";
4765+            return;
4766+	}
4767     } else {
4768 	unless(open(FH,"< $file")) {
4769             warn "Cannot open '$file'";
4770@@ -45,8 +51,12 @@ sub process_file {
4771
4772 sub get_files {
4773     my %file = ();
4774-    # VMS keeps its include files in system libraries (well, except for Gcc)
4775-    if ($^O eq 'VMS') {
4776+    if ($^O eq 'linux') {
4777+	# Some Linuxes have weird errno.hs which generate
4778+	# no #file or #line directives
4779+	$file{'/usr/include/errno.h'} = 1;
4780+    } elsif ($^O eq 'VMS') {
4781+	# VMS keeps its include files in system libraries (well, except for Gcc)
4782 	if ($Config{vms_cc_type} eq 'decc') {
4783 	    $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
4784 	} elsif ($Config{vms_cc_type} eq 'vaxc') {
4785EOPATCH
4786        }
4787    }
4788}
4789
4790sub patch_t {
4791    if ($^O eq 'darwin') {
4792        # This has # $x = `$^X -le "print 'hi there'"`;
4793        # and it needs to pass for the automated validation self-test:
4794        edit_file('t/base/term.t', sub {
4795                      my $code = shift;
4796                      $code =~ s/`(\$\^X )/`$aggressive_apple_security$1/;
4797                      return $code;
4798                  });
4799    }
4800}
4801
4802sub apply_fixups {
4803    my $fixups = shift;
4804    return unless $fixups;
4805    foreach my $file (@$fixups) {
4806        my $fh = open_or_die($file);
4807        my $line = <$fh>;
4808        close_or_die($fh);
4809        if ($line =~ /^#!perl\b/) {
4810            system $^X, $file
4811                and die_255("$^X $file failed: \$!=$!, \$?=$?");
4812        } elsif ($line =~ /^#!(\/\S+)/) {
4813            system $file
4814                and die_255("$file failed: \$!=$!, \$?=$?");
4815        } else {
4816            if (my ($target, $action, $pattern)
4817                = $line =~ m#^(\S+) ([=!])~ /(.*)/#) {
4818                if (length $pattern) {
4819                    next unless -f $target;
4820                    if ($action eq '=') {
4821                        next unless extract_from_file($target, $pattern);
4822                    } else {
4823                        next if extract_from_file($target, $pattern);
4824                    }
4825                } else {
4826                    # Avoid the special case meaning of the empty pattern,
4827                    # and instead use this to simply test for the file being
4828                    # present or absent
4829                    if ($action eq '=') {
4830                        next unless -f $target;
4831                    } else {
4832                        next if -f $target;
4833                    }
4834                }
4835            }
4836            system_or_die("patch -p1 <$file");
4837        }
4838    }
4839}
4840
4841# ex: set ts=8 sts=4 sw=4 et:
4842