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