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