This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
1fc70149fd7d508d7e8fba5d492c01cef531b401
[perl5.git] / Porting / bisect-runner.pl
1 #!/usr/bin/perl -w
2 use strict;
3
4 use Getopt::Long qw(:config bundling no_auto_abbrev);
5 use Pod::Usage;
6 use Config;
7
8 my @targets
9     = qw(config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep);
10
11 my $cpus;
12 if (open my $fh, '<', '/proc/cpuinfo') {
13     while (<$fh>) {
14         ++$cpus if /^processor\s+:\s+\d+$/;
15     }
16 } elsif (-x '/sbin/sysctl') {
17     $cpus = 1 + $1 if `/sbin/sysctl hw.ncpu` =~ /^hw\.ncpu: (\d+)$/;
18 } elsif (-x '/usr/bin/getconf') {
19     $cpus = 1 + $1 if `/usr/bin/getconf _NPROCESSORS_ONLN` =~ /^(\d+)$/;
20 }
21
22 my %options =
23     (
24      jobs => defined $cpus ? $cpus + 1 : 2,
25      'expect-pass' => 1,
26      clean => 1, # mostly for debugging this
27     );
28
29 my $linux64 = `uname -sm` eq "Linux x86_64\n" ? '64' : '';
30
31 my @paths;
32
33 if ($^O eq 'linux') {
34     # This is the search logic for a multi-arch library layout
35     # added to linux.sh in commits 40f026236b9959b7 and dcffd848632af2c7.
36     my $gcc = -x '/usr/bin/gcc' ? '/usr/bin/gcc' : 'gcc';
37
38     foreach (`$gcc -print-search-dirs`) {
39         next unless /^libraries: =(.*)/;
40         foreach (split ':', $1) {
41             next if m/gcc/;
42             next unless -d $_;
43             s!/$!!;
44             push @paths, $_;
45         }
46     }
47 }
48
49 push @paths, map {$_ . $linux64} qw(/usr/local/lib /lib /usr/lib);
50
51 my %defines =
52     (
53      usedevel => '',
54      optimize => '-g',
55      cc => 'ccache gcc',
56      ld => 'gcc',
57      ($linux64 ? (libpth => \@paths) : ()),
58     );
59
60 unless(GetOptions(\%options,
61                   'target=s', 'jobs|j=i', 'expect-pass=i',
62                   'expect-fail' => sub { $options{'expect-pass'} = 0; },
63                   'clean!', 'one-liner|e=s', 'match=s', 'force-manifest',
64                   'test-build', 'check-args', 'A=s@', 'usage|help|?',
65                   'D=s@' => sub {
66                       my (undef, $val) = @_;
67                       if ($val =~ /\A([^=]+)=(.*)/s) {
68                           $defines{$1} = length $2 ? $2 : "\0";
69                       } else {
70                           $defines{$val} = '';
71                       }
72                   },
73                   'U=s@' => sub {
74                       $defines{$_[1]} = undef;
75                   },
76                  )) {
77     pod2usage(exitval => 255, verbose => 1);
78 }
79
80 my ($target, $j, $match) = @options{qw(target jobs match)};
81
82 pod2usage(exitval => 255, verbose => 1) if $options{usage};
83 pod2usage(exitval => 255, verbose => 1)
84     unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'};
85
86 exit 0 if $options{'check-args'};
87
88 =head1 NAME
89
90 bisect.pl - use git bisect to pinpoint changes
91
92 =head1 SYNOPSIS
93
94     # When did this become an error?
95     .../Porting/bisect.pl -e 'my $a := 2;'
96     # When did this stop being an error?
97     .../Porting/bisect.pl --expect-fail -e '1 // 2'
98     # When did this stop matching?
99     .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b'
100     # When did this start matching?
101     .../Porting/bisect.pl --expect-fail --match '\buseithreads\b'
102     # When did this test program stop working?
103     .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl
104     # When did this first become valid syntax?
105     .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \
106          --expect-fail -e 'my $a := 2;'
107     # What was the last revision to build with these options?
108     .../Porting/bisect.pl --test-build -Dd_dosuid
109
110 =head1 DESCRIPTION
111
112 Together F<bisect.pl> and F<bisect-runner.pl> attempt to automate the use
113 of C<git bisect> as much as possible. With one command (and no other files)
114 it's easy to find out
115
116 =over 4
117
118 =item *
119
120 Which commit caused this example code to break?
121
122 =item *
123
124 Which commit caused this example code to start working?
125
126 =item *
127
128 Which commit added the first to match this regex?
129
130 =item *
131
132 Which commit removed the last to match this regex?
133
134 =back
135
136 usually without needing to know which versions of perl to use as start and
137 end revisions.
138
139 By default F<bisect.pl> will process all options, then use the rest of the
140 command line as arguments to list C<system> to run a test case. By default,
141 the test case should pass (exit with 0) on earlier perls, and fail (exit
142 non-zero) on I<blead>. F<bisect.pl> will use F<bisect-runner.pl> to find the
143 earliest stable perl version on which the test case passes, check that it
144 fails on blead, and then use F<bisect-runner.pl> with C<git bisect run> to
145 find the commit which caused the failure.
146
147 Because the test case is the complete argument to C<system>, it is easy to
148 run something other than the F<perl> built, if necessary. If you need to run
149 the perl built, you'll probably need to invoke it as C<./perl -Ilib ...>
150
151 You need a clean checkout to run a bisect, and you can't use the checkout
152 which contains F<Porting/bisect.pl> (because C<git bisect>) will check out
153 a revision before F<Porting/bisect-runner.pl> was added, which
154 C<git bisect run> needs). If your working checkout is called F<perl>, the
155 simplest solution is to make a local clone, and run from that. I<i.e.>:
156
157     cd ..
158     git clone perl perl2
159     cd perl2
160     ../perl/Porting/bisect.pl ...
161
162 By default, F<bisect-runner.pl> will automatically disable the build of
163 L<DB_File> for commits earlier than ccb44e3bf3be2c30, as it's not practical
164 to patch DB_File 1.70 and earlier to build with current Berkeley DB headers.
165 (ccb44e3bf3be2c30 was in September 1999, between 5.005_62 and 5.005_63.)
166 If your F<db.h> is old enough you can override this with C<-Unoextensions>.
167
168 =head1 OPTIONS
169
170 =over 4
171
172 =item *
173
174 --start I<commit-ish>
175
176 Earliest revision to test, as a I<commit-ish> (a tag, commit or anything
177 else C<git> understands as a revision). If not specified, F<bisect.pl> will
178 search stable perl releases from 5.002 to 5.14.0 until it finds one where
179 the test case passes.
180
181 =item *
182
183 --end I<commit-ish>
184
185 Most recent revision to test, as a I<commit-ish>. If not specified, defaults
186 to I<blead>.
187
188 =item *
189
190 --target I<target>
191
192 F<Makefile> target (or equivalent) needed, to run the test case. If specified,
193 this should be one of
194
195 =over 4
196
197 =item *
198
199 I<config.sh>
200
201 Just run F<./Configure>
202
203 =item *
204
205 I<config.h>
206
207 Run the various F<*.SH> files to generate F<Makefile>, F<config.h>, I<etc>.
208
209 =item *
210
211 I<miniperl>
212
213 Build F<miniperl>.
214
215 =item *
216
217 I<lib/Config.pm>
218
219 Use F<miniperl> to build F<lib/Config.pm>
220
221 =item *
222
223 I<Fcntl>
224
225 Build F<lib/auto/Fcntl/Fnctl.so> (strictly, C<.$Config{so}>). As L<Fcntl>
226 is simple XS module present since 5.000, this provides a fast test of
227 whether XS modules can be built. Note, XS modules are built by F<miniperl>,
228 hence this target will not build F<perl>.
229
230 =item *
231
232 I<perl>
233
234 Build F<perl>. This also builds pure-Perl modules in F<cpan>, F<dist> and
235 F<ext>. XS modules (such as L<Fcntl>) are not built.
236
237 =item *
238
239 I<test_prep>
240
241 Build everything needed to run the tests. This is the default if we're
242 running test code, but is time consuming, as it means building all
243 XS modules. For older F<Makefile>s, the previous name of C<test-prep>
244 is automatically substituted. For very old F<Makefile>s, C<make test> is
245 run, as there is no target provided to just get things ready, and for 5.004
246 and earlier the tests run very quickly.
247
248 =back
249
250 =item *
251
252 --one-liner 'code to run'
253
254 =item *
255
256 -e 'code to run'
257
258 Example code to run, just like you'd use with C<perl -e>.
259
260 This prepends C<./perl -Ilib -e 'code to run'> to the test case given,
261 or F<./miniperl> if I<target> is C<miniperl>.
262
263 (Usually you'll use C<-e> instead of providing a test case in the
264 non-option arguments to F<bisect.pl>)
265
266 C<-E> intentionally isn't supported, as it's an error in 5.8.0 and earlier,
267 which interferes with detecting errors in the example code itself.
268
269 =item *
270
271 --expect-fail
272
273 The test case should fail for the I<start> revision, and pass for the I<end>
274 revision. The bisect run will find the first commit where it passes.
275
276 =item *
277
278 -Dnoextensions=Encode
279
280 =item *
281
282 -Uusedevel
283
284 =item *
285
286 -Accflags=-DNO_MATHOMS
287
288 Arguments to pass to F<Configure>. Repeated C<-A> arguments are passed
289 through as is. C<-D> and C<-U> are processed in order, and override
290 previous settings for the same parameter. F<bisect-runner.pl> emulates
291 C<-Dnoextensions> when F<Configure> itself does not provide it, as it's
292 often very useful to be able to disable some XS extensions.
293
294 =item *
295
296 --jobs I<jobs>
297
298 =item *
299
300 -j I<jobs>
301
302 Number of C<make> jobs to run in parallel. If F</proc/cpuinfo> exists and
303 can be parsed, or F</sbin/sysctl> exists and reports C<hw.ncpu>, or
304 F</usr/bin/getconf> exists and reports C<_NPROCESSORS_ONLN> defaults to 1 +
305 I<number of CPUs>. Otherwise defaults to 2.
306
307 =item *
308
309 --match pattern
310
311 Instead of running a test program to determine I<pass> or I<fail>, pass
312 if the given regex matches, and hence search for the commit that removes
313 the last matching file.
314
315 If no I<target> is specified, the match is against all files in the
316 repository (which is fast). If a I<target> is specified, that target is
317 built, and the match is against only the built files. C<--expect-fail> can
318 be used with C<--match> to search for a commit that adds files that match.
319
320 =item *
321
322 --test-build
323
324 Test that the build completes, without running any test case.
325
326 By default, if the build for the desired I<target> fails to complete,
327 F<bisect-runner.pl> reports a I<skip> back to C<git bisect>, the assumption
328 being that one wants to find a commit which changed state "builds && passes"
329 to "builds && fails". If instead one is interested in which commit broke the
330 build (possibly for particular F<Configure> options), use I<--test-build>
331 to treat a build failure as a failure, not a "skip".
332
333 Often this option isn't as useful as it first seems, because I<any> build
334 failure will be reported to C<git bisect> as a failure, not just the failure
335 that you're interested in. Generally, to debug a particular problem, it's
336 more useful to use a I<target> that builds properly at the point of interest,
337 and then a test case that runs C<make>. For example:
338
339     .../Porting/bisect.pl --start=perl-5.000 --end=perl-5.002 \
340         --expect-fail --force-manifest --target=miniperl make perl
341
342 will find the first revision capable of building L<DynaLoader> and then
343 F<perl>, without becoming confused by revisions where F<miniperl> won't
344 even link.
345
346 =item *
347
348 --force-manifest
349
350 By default, a build will "skip" if any files listed in F<MANIFEST> are not
351 present. Usually this is useful, as it avoids false-failures. However, there
352 are some long ranges of commits where listed files are missing, which can
353 cause a bisect to abort because all that remain are skipped revisions.
354
355 In these cases, particularly if the test case uses F<miniperl> and no modules,
356 it may be more useful to force the build to continue, even if files
357 F<MANIFEST> are missing.
358
359 =item *
360
361 --expect-pass [0|1]
362
363 C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1> is the default.
364
365 =item *
366
367 --no-clean
368
369 Tell F<bisect-runner.pl> not to clean up after the build. This allows one
370 to use F<bisect-runner.pl> to build the current particular perl revision for
371 interactive testing, or for debugging F<bisect-runner.pl>.
372
373 Passing this to F<bisect.pl> will likely cause the bisect to fail badly.
374
375 =item *
376
377 --check-args
378
379 Validate the options and arguments, and exit silently if they are valid.
380
381 =item *
382
383 --usage
384
385 =item *
386
387 --help
388
389 =item *
390
391 -?
392
393 Display the usage information and exit.
394
395 =back
396
397 =cut
398
399 die "$0: Can't build $target" if defined $target && !grep {@targets} $target;
400
401 $j = "-j$j" if $j =~ /\A\d+\z/;
402
403 # Sadly, however hard we try, I don't think that it will be possible to build
404 # modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29,
405 # which updated to MakeMaker 3.7, which changed from using a hard coded ld
406 # in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc.
407
408 sub extract_from_file {
409     my ($file, $rx, $default) = @_;
410     open my $fh, '<', $file or die "Can't open $file: $!";
411     while (<$fh>) {
412         my @got = $_ =~ $rx;
413         return wantarray ? @got : $got[0]
414             if @got;
415     }
416     return $default if defined $default;
417     return;
418 }
419
420 sub edit_file {
421     my ($file, $munger) = @_;
422     local $/;
423     open my $fh, '<', $file or die "Can't open $file: $!";
424     my $orig = <$fh>;
425     die "Can't read $file: $!" unless defined $orig && close $fh;
426     my $new = $munger->($orig);
427     return if $new eq $orig;
428     open $fh, '>', $file or die "Can't open $file: $!";
429     print $fh $new or die "Can't print to $file: $!";
430     close $fh or die "Can't close $file: $!";
431 }
432
433 sub apply_patch {
434     my $patch = shift;
435
436     my ($file) = $patch =~ qr!^diff.*a/(\S+) b/\1!;
437     open my $fh, '|-', 'patch', '-p1' or die "Can't run patch: $!";
438     print $fh $patch;
439     return if close $fh;
440     print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n";
441     die "Can't patch $file: $?, $!";
442 }
443
444 sub clean {
445     if ($options{clean}) {
446         # Needed, because files that are build products in this checked out
447         # version might be in git in the next desired version.
448         system 'git clean -dxf </dev/null';
449         # Needed, because at some revisions the build alters checked out files.
450         # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
451         system 'git reset --hard HEAD </dev/null';
452     }
453 }
454
455 sub skip {
456     my $reason = shift;
457     clean();
458     warn "skipping - $reason";
459     exit 125;
460 }
461
462 sub report_and_exit {
463     my ($ret, $pass, $fail, $desc) = @_;
464
465     clean();
466
467     my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad';
468     if ($ret) {
469         print "$got - $fail $desc\n";
470     } else {
471         print "$got - $pass $desc\n";
472     }
473
474     exit($got eq 'bad');
475 }
476
477 sub match_and_exit {
478     my $target = shift;
479     my $matches = 0;
480     my $re = qr/$match/;
481     my @files;
482
483     {
484         local $/ = "\0";
485         @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`;
486         chomp @files;
487     }
488
489     foreach my $file (@files) {
490         open my $fh, '<', $file or die "Can't open $file: $!";
491         while (<$fh>) {
492             if ($_ =~ $re) {
493                 ++$matches;
494                 if (tr/\t\r\n -~\200-\377//c) {
495                     print "Binary file $file matches\n";
496                 } else {
497                     $_ .= "\n" unless /\n\z/;
498                     print "$file: $_";
499                 }
500             }
501         }
502         close $fh or die "Can't close $file: $!";
503     }
504     report_and_exit(!$matches,
505                     $matches == 1 ? '1 match for' : "$matches matches for",
506                     'no matches for', $match);
507 }
508
509 # Not going to assume that system perl is yet new enough to have autodie
510 system 'git clean -dxf </dev/null' and die;
511
512 if (!defined $target) {
513     match_and_exit() if $match;
514     $target = 'test_prep';
515 }
516
517 skip('no Configure - is this the //depot/perlext/Compiler branch?')
518     unless -f 'Configure';
519
520 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
521 my $major
522     = extract_from_file('patchlevel.h',
523                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
524                         0);
525
526 if ($major < 1) {
527     if (extract_from_file('Configure',
528                           qr/^          \*=\*\) echo "\$1" >> \$optdef;;$/)) {
529         # This is "        Spaces now allowed in -D command line options.",
530         # part of commit ecfc54246c2a6f42
531         apply_patch(<<'EOPATCH');
532 diff --git a/Configure b/Configure
533 index 3d3b38d..78ffe16 100755
534 --- a/Configure
535 +++ b/Configure
536 @@ -652,7 +777,8 @@ while test $# -gt 0; do
537                         echo "$me: use '-U symbol=', not '-D symbol='." >&2
538                         echo "$me: ignoring -D $1" >&2
539                         ;;
540 -               *=*) echo "$1" >> $optdef;;
541 +               *=*) echo "$1" | \
542 +                               sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;;
543                 *) echo "$1='define'" >> $optdef;;
544                 esac
545                 shift
546 EOPATCH
547     }
548     if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) {
549         # Configure's original simple "grep" for d_namlen falls foul of the
550         # approach taken by the glibc headers:
551         # #ifdef _DIRENT_HAVE_D_NAMLEN
552         # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen)
553         #
554         # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux.
555         # This is also part of commit ecfc54246c2a6f42
556         apply_patch(<<'EOPATCH');
557 diff --git a/Configure b/Configure
558 index 3d3b38d..78ffe16 100755
559 --- a/Configure
560 +++ b/Configure
561 @@ -3935,7 +4045,8 @@ $rm -f try.c
562  
563  : see if the directory entry stores field length
564  echo " "
565 -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
566 +$cppstdin $cppflags $cppminus < "$xinc" > try.c
567 +if $contains 'd_namlen' try.c >/dev/null 2>&1; then
568         echo "Good, your directory entry keeps length information in d_namlen." >&4
569         val="$define"
570  else
571 EOPATCH
572     }
573 }
574
575 if ($major < 8 && !extract_from_file('Configure',
576                                     qr/^\t\tif test ! -t 0; then$/)) {
577     # Before dfe9444ca7881e71, Configure would refuse to run if stdin was not a
578     # tty. With that commit, the tty requirement was dropped for -de and -dE
579     # Commit aaeb8e512e8e9e14 dropped the tty requirement for -S
580     # For those older versions, it's probably easiest if we simply remove the
581     # sanity test.
582     edit_file('Configure', sub {
583                   my $code = shift;
584                   $code =~ s/test ! -t 0/test Perl = rules/;
585                   return $code;
586               });
587 }
588
589 if ($major < 10 && extract_from_file('Configure', qr/^set malloc\.h i_malloc$/)) {
590     # This is commit 01d07975f7ef0e7d, trimmed, with $compile inlined as
591     # prior to bd9b35c97ad661cc Configure had the malloc.h test before the
592     # definition of $compile.
593     apply_patch(<<'EOPATCH');
594 diff --git a/Configure b/Configure
595 index 3d2e8b9..6ce7766 100755
596 --- a/Configure
597 +++ b/Configure
598 @@ -6743,5 +6743,22 @@ set d_dosuid
599  
600  : see if this is a malloc.h system
601 -set malloc.h i_malloc
602 -eval $inhdr
603 +: we want a real compile instead of Inhdr because some systems have a
604 +: malloc.h that just gives a compile error saying to use stdlib.h instead
605 +echo " "
606 +$cat >try.c <<EOCP
607 +#include <stdlib.h>
608 +#include <malloc.h>
609 +int main () { return 0; }
610 +EOCP
611 +set try
612 +if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then
613 +    echo "<malloc.h> found." >&4
614 +    val="$define"
615 +else
616 +    echo "<malloc.h> NOT found." >&4
617 +    val="$undef"
618 +fi
619 +$rm -f try.c try
620 +set i_malloc
621 +eval $setvar
622  
623 EOPATCH
624 }
625
626 if ($major < 10 && -d 'ext/Unicode/Normalize/'
627     && !extract_from_file('Configure', qr/^extra_dep=''$/)) {
628     # The Makefile.PL for Unicode::Normalize needs
629     # lib/unicore/CombiningClass.pl. Even without a parallel build, we need
630     # a dependency to ensure that it builds. This is a variant of commit
631     # 9f3ef600c170f61e
632     apply_patch(<<'EOPATCH');
633 diff --git a/Makefile.SH b/Makefile.SH
634 index f61d0db..6097954 100644
635 --- a/Makefile.SH
636 +++ b/Makefile.SH
637 @@ -155,10 +155,20 @@ esac
638  
639  : Prepare dependency lists for Makefile.
640  dynamic_list=' '
641 +extra_dep=''
642  for f in $dynamic_ext; do
643      : the dependency named here will never exist
644        base=`echo "$f" | sed 's/.*\///'`
645 -    dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext"
646 +    this_target="lib/auto/$f/$base.$dlext"
647 +    dynamic_list="$dynamic_list $this_target"
648 +
649 +    : Parallel makes reveal that we have some interdependencies
650 +    case $f in
651 +       Math/BigInt/FastCalc) extra_dep="$extra_dep
652 +$this_target: lib/auto/List/Util/Util.$dlext" ;;
653 +       Unicode/Normalize) extra_dep="$extra_dep
654 +$this_target: lib/unicore/CombiningClass.pl" ;;
655 +    esac
656  done
657  
658  static_list=' '
659 @@ -987,2 +997,9 @@ n_dummy $(nonxs_ext):       miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE
660         @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
661 +!NO!SUBS!
662 +
663 +$spitshell >>Makefile <<EOF
664 +$extra_dep
665 +EOF
666 +
667 +$spitshell >>Makefile <<'!NO!SUBS!'
668  
669 EOPATCH
670 }
671
672 # There was a bug in makedepend.SH which was fixed in version 96a8704c.
673 # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
674 # Remove this if you're actually bisecting a problem related to makedepend.SH
675 system 'git show blead:makedepend.SH > makedepend.SH </dev/null' and die;
676
677 if ($^O eq 'freebsd') {
678     # There are rather too many version-specific FreeBSD hints fixes to patch
679     # individually. Also, more than once the FreeBSD hints file has been
680     # written in what turned out to be a rather non-future-proof style,
681     # with case statements treating the most recent version as the exception,
682     # instead of treating previous versions' behaviour explicitly and changing
683     # the default to cater for the current behaviour. (As strangely, future
684     # versions inherit the current behaviour.)
685     system 'git show blead:hints/freebsd.sh > hints/freebsd.sh </dev/null'
686       and die;
687
688     if ($major < 2) {
689         # 5.002 Configure and later have code to
690         #
691         # : Try to guess additional flags to pick up local libraries.
692         #
693         # which will automatically add --L/usr/local/lib because libpth
694         # contains /usr/local/lib
695         #
696         # Without it, if Configure finds libraries in /usr/local/lib (eg
697         # libgdbm.so) and adds them to the compiler commandline (as -lgdbm),
698         # then the link will fail. We can't fix this up in config.sh because
699         # the link will *also* fail in the test compiles that Configure does
700         # (eg $inlibc) which makes Configure get all sorts of things
701         # wrong. :-( So bodge it here.
702         #
703         # Possibly other platforms will need something similar. (if they
704         # have "wanted" libraries in /usr/local/lib, but the compiler
705         # doesn't default to putting that directory in its link path)
706         apply_patch(<<'EOPATCH');
707 --- perl2/hints/freebsd.sh.orig 2011-10-05 16:44:55.000000000 +0200
708 +++ perl2/hints/freebsd.sh      2011-10-05 16:45:52.000000000 +0200
709 @@ -125,7 +125,7 @@
710          else
711              libpth="/usr/lib /usr/local/lib"
712              glibpth="/usr/lib /usr/local/lib"
713 -            ldflags="-Wl,-E "
714 +            ldflags="-Wl,-E -L/usr/local/lib "
715              lddlflags="-shared "
716          fi
717          cccdlflags='-DPIC -fPIC'
718 @@ -133,7 +133,7 @@
719  *)
720         libpth="/usr/lib /usr/local/lib"
721         glibpth="/usr/lib /usr/local/lib"
722 -       ldflags="-Wl,-E "
723 +       ldflags="-Wl,-E -L/usr/local/lib "
724          lddlflags="-shared "
725          cccdlflags='-DPIC -fPIC'
726         ;;
727 EOPATCH
728     }
729 } elsif ($^O eq 'darwin') {
730     if ($major < 8) {
731         my $faking_it;
732         # We can't build on darwin without some of the data in the hints file.
733         foreach ('ext/DynaLoader/dl_dyld.xs', 'hints/darwin.sh') {
734             next if -f $_;
735             ++$faking_it;
736             # Probably less surprising to use the earliest version of
737             # hints/darwin.sh and then edit in place just below, than use
738             # blead's version, as that would create a discontinuity at
739             # f556e5b971932902 - before it, hints bugs would be "fixed", after
740             # it they'd resurface. This way, we should give the illusion of
741             # monotonic bug fixing.
742             system "git show f556e5b971932902:$_ >$_"
743                 and die "while attempting to extract $_";
744         }
745         if ($faking_it) {
746             apply_patch(<<'EOPATCH');
747 diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
748 --- a/ext/DynaLoader/dl_dyld.xs~        2011-10-11 21:41:27.000000000 +0100
749 +++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:42:20.000000000 +0100
750 @@ -41,6 +41,35 @@
751  #include "perl.h"
752  #include "XSUB.h"
753  
754 +#ifndef pTHX
755 +#  define pTHX         void
756 +#  define pTHX_
757 +#endif
758 +#ifndef aTHX
759 +#  define aTHX
760 +#  define aTHX_
761 +#endif
762 +#ifndef dTHX
763 +#  define dTHXa(a)     extern int Perl___notused(void)
764 +#  define dTHX         extern int Perl___notused(void)
765 +#endif
766 +
767 +#ifndef Perl_form_nocontext
768 +#  define Perl_form_nocontext form
769 +#endif
770 +
771 +#ifndef Perl_warn_nocontext
772 +#  define Perl_warn_nocontext warn
773 +#endif
774 +
775 +#ifndef PTR2IV
776 +#  define PTR2IV(p)    (IV)(p)
777 +#endif
778 +
779 +#ifndef get_av
780 +#  define get_av perl_get_av
781 +#endif
782 +
783  #define DL_LOADONCEONLY
784  
785  #include "dlutils.c"   /* SaveError() etc      */
786 @@ -185,7 +191,7 @@
787      CODE:
788      DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
789      if (flags & 0x01)
790 -       Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
791 +       Perl_warn_nocontext("Can't make loaded symbols global on this platform while loading %s",filename);
792      RETVAL = dlopen(filename, mode) ;
793      DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
794      ST(0) = sv_newmortal() ;
795 EOPATCH
796             if ($major < 4 && !extract_from_file('util.c', qr/^form/m)) {
797                 apply_patch(<<'EOPATCH');
798 diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
799 --- a/ext/DynaLoader/dl_dyld.xs~        2011-10-11 21:56:25.000000000 +0100
800 +++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 22:00:00.000000000 +0100
801 @@ -60,6 +60,18 @@
802  #  define get_av perl_get_av
803  #endif
804  
805 +static char *
806 +form(char *pat, ...)
807 +{
808 +    char *retval;
809 +    va_list args;
810 +    va_start(args, pat);
811 +    vasprintf(&retval, pat, &args);
812 +    va_end(args);
813 +    SAVEFREEPV(retval);
814 +    return retval;
815 +}
816 +
817  #define DL_LOADONCEONLY
818  
819  #include "dlutils.c"   /* SaveError() etc      */
820 EOPATCH
821             }
822         }
823
824         edit_file('hints/darwin.sh', sub {
825                       my $code = shift;
826                       # Part of commit 8f4f83badb7d1ba9, which mostly undoes
827                       # commit 0511a818910f476c.
828                       $code =~ s/^cppflags='-traditional-cpp';$/cppflags="\${cppflags} -no-cpp-precomp"/m;
829                       # commit 14c11978e9b52e08/803bb6cc74d36a3f
830                       # Without this, code in libperl.bundle links against op.o
831                       # in preference to opmini.o on the linker command line,
832                       # and hence miniperl tries to use File::Glob instead of
833                       # csh
834                       $code =~ s/^(lddlflags=)/ldflags="\${ldflags} -flat_namespace"\n$1/m;
835                       # f556e5b971932902 also patches Makefile.SH with some
836                       # special case code to deal with useshrplib for darwin.
837                       # Given that post 5.8.0 the darwin hints default was
838                       # changed to false, and it would be very complex to splice
839                       # in that code in various versions of Makefile.SH back
840                       # to 5.002, lets just turn it off.
841                       $code =~ s/^useshrplib='true'/useshrplib='false'/m
842                           if $faking_it;
843                       return $code;
844                   });
845     }
846 } elsif ($^O eq 'netbsd') {
847     if ($major < 6) {
848         # These are part of commit 099685bc64c7dbce
849         edit_file('hints/netbsd.sh', sub {
850                       my $code = shift;
851                       my $fixed = <<'EOC';
852 case "$osvers" in
853 0.9|0.8*)
854         usedl="$undef"
855         ;;
856 *)
857         if [ -f /usr/libexec/ld.elf_so ]; then
858                 d_dlopen=$define
859                 d_dlerror=$define
860                 ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags"
861                 cccdlflags="-DPIC -fPIC $cccdlflags"
862                 lddlflags="--whole-archive -shared $lddlflags"
863         elif [ "`uname -m`" = "pmax" ]; then
864 # NetBSD 1.3 and 1.3.1 on pmax shipped an `old' ld.so, which will not work.
865                 d_dlopen=$undef
866         elif [ -f /usr/libexec/ld.so ]; then
867                 d_dlopen=$define
868                 d_dlerror=$define
869                 ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags"
870 # we use -fPIC here because -fpic is *NOT* enough for some of the
871 # extensions like Tk on some netbsd platforms (the sparc is one)
872                 cccdlflags="-DPIC -fPIC $cccdlflags"
873                 lddlflags="-Bforcearchive -Bshareable $lddlflags"
874         else
875                 d_dlopen=$undef
876         fi
877         ;;
878 esac
879 EOC
880                       $code =~ s/^case "\$osvers" in\n0\.9\|0\.8.*?^esac\n/$fixed/ms;
881                       return $code;
882                   });
883         if (!extract_from_file('unixish.h',
884                                qr/defined\(NSIG\).*defined\(__NetBSD__\)/)) {
885             apply_patch(<<'EOPATCH')
886 diff --git a/unixish.h b/unixish.h
887 index 2a6cbcd..eab2de1 100644
888 --- a/unixish.h
889 +++ b/unixish.h
890 @@ -89,7 +89,7 @@
891   */
892  /* #define ALTERNATE_SHEBANG "#!" / **/
893  
894 -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
895 +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
896  # include <signal.h>
897  #endif
898  
899 EOPATCH
900         }
901     }
902 }
903
904 if ($major < 10) {
905     if (!extract_from_file('ext/DB_File/DB_File.xs',
906                            qr!^#else /\* Berkeley DB Version > 2 \*/$!)) {
907         # This DB_File.xs is really too old to patch up.
908         # Skip DB_File, unless we're invoked with an explicit -Unoextensions
909         if (!exists $defines{noextensions}) {
910             $defines{noextensions} = 'DB_File';
911         } elsif (defined $defines{noextensions}) {
912             $defines{noextensions} .= ' DB_File';
913         }
914     } elsif (!extract_from_file('ext/DB_File/DB_File.xs',
915                                 qr/^#ifdef AT_LEAST_DB_4_1$/)) {
916         # This line is changed by commit 3245f0580c13b3ab
917         my $line = extract_from_file('ext/DB_File/DB_File.xs',
918                                      qr/^(        status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/);
919         apply_patch(<<"EOPATCH");
920 diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
921 index 489ba96..fba8ded 100644
922 --- a/ext/DB_File/DB_File.xs
923 +++ b/ext/DB_File/DB_File.xs
924 \@\@ -183,4 +187,8 \@\@
925  #endif
926  
927 +#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
928 +#    define AT_LEAST_DB_4_1
929 +#endif
930 +
931  /* map version 2 features & constants onto their version 1 equivalent */
932  
933 \@\@ -1334,7 +1419,12 \@\@ SV *   sv ;
934  #endif
935  
936 +#ifdef AT_LEAST_DB_4_1
937 +        status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type, 
938 +                               Flags, mode) ; 
939 +#else
940  $line
941                                 Flags, mode) ; 
942 +#endif
943         /* printf("open returned %d %s\\n", status, db_strerror(status)) ; */
944  
945 EOPATCH
946     }
947 }
948
949 # if Encode is not needed for the test, you can speed up the bisect by
950 # excluding it from the runs with -Dnoextensions=Encode
951 # ccache is an easy win. Remove it if it causes problems.
952 # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
953 # to true in hints/linux.sh
954 # On dromedary, from that point on, Configure (by default) fails to find any
955 # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
956 # versioned libraries. Without -lm, the build fails.
957 # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
958 # until commit faae14e6e968e1c0 adds it to the hints.
959 # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
960 # because it will spot versioned libraries, pass them to the compiler, and then
961 # bail out pretty early on. Configure won't let us override libswanted, but it
962 # will let us override the entire libs list.
963
964 unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
965     # Before 1cfa4ec74d4933da, so force the libs list.
966
967     my @libs;
968     # This is the current libswanted list from Configure, less the libs removed
969     # by current hints/linux.sh
970     foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
971                         ld sun m crypt sec util c cposix posix ucb BSD)) {
972         foreach my $dir (@paths) {
973             next unless -f "$dir/lib$lib.so";
974             push @libs, "-l$lib";
975             last;
976         }
977     }
978     $defines{libs} = \@libs unless exists $defines{libs};
979 }
980
981 $defines{usenm} = undef
982     if $major < 2 && !exists $defines{usenm};
983
984 my (@missing, @created_dirs);
985
986 if ($options{'force-manifest'}) {
987     open my $fh, '<', 'MANIFEST'
988         or die "Could not open MANIFEST: $!";
989     while (<$fh>) {
990         next unless /^(\S+)/;
991         push @missing, $1
992             unless -f $1;
993     }
994     close $fh or die "Can't close MANIFEST: $!";
995
996     foreach my $pathname (@missing) {
997         my @parts = split '/', $pathname;
998         my $leaf = pop @parts;
999         my $path = '.';
1000         while (@parts) {
1001             $path .= '/' . shift @parts;
1002             next if -d $path;
1003             mkdir $path, 0700 or die "Can't create $path: $!";
1004             unshift @created_dirs, $path;
1005         }
1006         open $fh, '>', $pathname or die "Can't open $pathname: $!";
1007         close $fh or die "Can't close $pathname: $!";
1008         chmod 0, $pathname or die "Can't chmod 0 $pathname: $!";
1009     }
1010 }
1011
1012 my @ARGS = '-dEs';
1013 foreach my $key (sort keys %defines) {
1014     my $val = $defines{$key};
1015     if (ref $val) {
1016         push @ARGS, "-D$key=@$val";
1017     } elsif (!defined $val) {
1018         push @ARGS, "-U$key";
1019     } elsif (!length $val) {
1020         push @ARGS, "-D$key";
1021     } else {
1022         $val = "" if $val eq "\0";
1023         push @ARGS, "-D$key=$val";
1024     }
1025 }
1026 push @ARGS, map {"-A$_"} @{$options{A}};
1027
1028 # </dev/null because it seems that some earlier versions of Configure can
1029 # call commands in a way that now has them reading from stdin (and hanging)
1030 my $pid = fork;
1031 die "Can't fork: $!" unless defined $pid;
1032 if (!$pid) {
1033     open STDIN, '<', '/dev/null';
1034     # If a file in MANIFEST is missing, Configure asks if you want to
1035     # continue (the default being 'n'). With stdin closed or /dev/null,
1036     # it exits immediately and the check for config.sh below will skip.
1037     exec './Configure', @ARGS;
1038     die "Failed to start Configure: $!";
1039 }
1040 waitpid $pid, 0
1041     or die "wait for Configure, pid $pid failed: $!";
1042
1043 # Emulate noextensions if Configure doesn't support it.
1044 if (-f 'config.sh') {
1045     if ($major < 10 && $defines{noextensions}) {
1046         edit_file('config.sh', sub {
1047                       my @lines = split /\n/, shift;
1048                       my @ext = split /\s+/, $defines{noextensions};
1049                       foreach (@lines) {
1050                           next unless /^extensions=/ || /^dynamic_ext/;
1051                           foreach my $ext (@ext) {
1052                               s/\b$ext( )?\b/$1/;
1053                           }
1054                       }
1055                       return join "\n", @lines;
1056                   });
1057     }
1058     if ($major < 4 && !extract_from_file('config.sh', qr/^trnl=/)) {
1059         # This seems to be necessary to avoid makedepend becoming confused,
1060         # and hanging on stdin. Seems that the code after
1061         # make shlist || ...here... is never run.
1062         edit_file('makedepend.SH', sub {
1063                       my $code = shift;
1064                       $code =~ s/^trnl='\$trnl'$/trnl='\\n'/m;
1065                       return $code;
1066                   });
1067     }
1068
1069     system './Configure -S </dev/null' and die;
1070 }
1071
1072 if ($target =~ /config\.s?h/) {
1073     match_and_exit($target) if $match && -f $target;
1074     report_and_exit(!-f $target, 'could build', 'could not build', $target);
1075 } elsif (!-f 'config.sh') {
1076     # Skip if something went wrong with Configure
1077
1078     skip('could not build config.sh');
1079 }
1080
1081 # This is probably way too paranoid:
1082 if (@missing) {
1083     my @errors;
1084     require Fcntl;
1085     foreach my $file (@missing) {
1086         my (undef, undef, $mode, undef, undef, undef, undef, $size)
1087             = stat $file;
1088         if (!defined $mode) {
1089             push @errors, "Added file $file has been deleted by Configure";
1090             next;
1091         }
1092         if (Fcntl::S_IMODE($mode) != 0) {
1093             push @errors,
1094                 sprintf 'Added file %s had mode changed by Configure to %03o',
1095                     $file, $mode;
1096         }
1097         if ($size != 0) {
1098             push @errors,
1099                 "Added file $file had sized changed by Configure to $size";
1100         }
1101         unlink $file or die "Can't unlink $file: $!";
1102     }
1103     foreach my $dir (@created_dirs) {
1104         rmdir $dir or die "Can't rmdir $dir: $!";
1105     }
1106     skip("@errors")
1107         if @errors;
1108 }
1109
1110 # Correct makefile for newer GNU gcc
1111 # Only really needed if you comment out the use of blead's makedepend.SH
1112 {
1113     local $^I = "";
1114     local @ARGV = qw(makefile x2p/makefile);
1115     while (<>) {
1116         print unless /<(?:built-in|command|stdin)/;
1117     }
1118 }
1119
1120 if ($major == 2 && extract_from_file('perl.c', qr/^     fclose\(e_fp\);$/)) {
1121     # need to patch perl.c to avoid calling fclose() twice on e_fp when using -e
1122     # This diff is part of commit ab821d7fdc14a438. The second close was
1123     # introduced with perl-5.002, commit a5f75d667838e8e7
1124     # Might want a6c477ed8d4864e6 too, for the corresponding change to pp_ctl.c
1125     # (likely without this, eval will have "fun")
1126     apply_patch(<<'EOPATCH');
1127 diff --git a/perl.c b/perl.c
1128 index 03c4d48..3c814a2 100644
1129 --- a/perl.c
1130 +++ b/perl.c
1131 @@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
1132  #ifndef VMS  /* VMS doesn't have environ array */
1133      origenviron = environ;
1134  #endif
1135 +    e_tmpname = Nullch;
1136  
1137      if (do_undump) {
1138  
1139 @@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
1140      if (e_fp) {
1141         if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
1142             croak("Can't write to temp file for -e: %s", Strerror(errno));
1143 +       e_fp = Nullfp;
1144         argc++,argv--;
1145         scriptname = e_tmpname;
1146      }
1147 @@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
1148      curcop->cop_line = 0;
1149      curstash = defstash;
1150      preprocess = FALSE;
1151 -    if (e_fp) {
1152 -       fclose(e_fp);
1153 -       e_fp = Nullfp;
1154 +    if (e_tmpname) {
1155         (void)UNLINK(e_tmpname);
1156 +       Safefree(e_tmpname);
1157 +       e_tmpname = Nullch;
1158      }
1159  
1160      /* now that script is parsed, we can modify record separator */
1161 @@ -1369,7 +1371,7 @@ SV *sv;
1162         scriptname = xfound;
1163      }
1164  
1165 -    origfilename = savepv(e_fp ? "-e" : scriptname);
1166 +    origfilename = savepv(e_tmpname ? "-e" : scriptname);
1167      curcop->cop_filegv = gv_fetchfile(origfilename);
1168      if (strEQ(origfilename,"-"))
1169         scriptname = "";
1170
1171 EOPATCH
1172 }
1173
1174 if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') {
1175     edit_file('ext/IPC/SysV/SysV.xs', sub {
1176                   my $xs = shift;
1177                   my $fixed = <<'EOFIX';
1178
1179 #include <sys/types.h>
1180 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
1181 #ifndef HAS_SEM
1182 #   include <sys/ipc.h>
1183 #endif
1184 #   ifdef HAS_MSG
1185 #       include <sys/msg.h>
1186 #   endif
1187 #   ifdef HAS_SHM
1188 #       if defined(PERL_SCO) || defined(PERL_ISC)
1189 #           include <sys/sysmacros.h>   /* SHMLBA */
1190 #       endif
1191 #      include <sys/shm.h>
1192 #      ifndef HAS_SHMAT_PROTOTYPE
1193            extern Shmat_t shmat (int, char *, int);
1194 #      endif
1195 #      if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
1196 #          undef  SHMLBA /* not static: determined at boot time */
1197 #          define SHMLBA sysconf(_SC_PAGESIZE)
1198 #      elif defined(HAS_GETPAGESIZE)
1199 #          undef  SHMLBA /* not static: determined at boot time */
1200 #          define SHMLBA getpagesize()
1201 #      endif
1202 #   endif
1203 #endif
1204 EOFIX
1205                   $xs =~ s!
1206 #include <sys/types\.h>
1207 .*
1208 (#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms;
1209                   return $xs;
1210               });
1211 }
1212
1213 # Parallel build for miniperl is safe
1214 system "make $j miniperl </dev/null";
1215
1216 my $expected = $target =~ /^test/ ? 't/perl'
1217     : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}"
1218     : $target;
1219 my $real_target = $target eq 'Fcntl' ? $expected : $target;
1220
1221 if ($target ne 'miniperl') {
1222     # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
1223     $j = '' if $major < 10;
1224
1225     if ($real_target eq 'test_prep') {
1226         if ($major < 8) {
1227             # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
1228             # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
1229             # earlier than that, just make test. It will be fast enough.
1230             $real_target = extract_from_file('Makefile.SH',
1231                                              qr/^(test[-_]prep):/,
1232                                              'test');
1233         }
1234     }
1235
1236     system "make $j $real_target </dev/null";
1237 }
1238
1239 my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;
1240
1241 if ($options{'test-build'}) {
1242     report_and_exit($missing_target, 'could build', 'could not build',
1243                     $real_target);
1244 } elsif ($missing_target) {
1245     skip("could not build $real_target");
1246 }
1247
1248 match_and_exit($real_target) if $match;
1249
1250 if (defined $options{'one-liner'}) {
1251     my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl';
1252     unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'};
1253 }
1254
1255 # This is what we came here to run:
1256
1257 if (exists $Config{ldlibpthname}) {
1258     require Cwd;
1259     my $varname = $Config{ldlibpthname};
1260     my $cwd = Cwd::getcwd();
1261     if (defined $ENV{$varname}) {
1262         $ENV{$varname} = $cwd . $Config{path_sep} . $ENV{$varname};
1263     } else {
1264         $ENV{$varname} = $cwd;
1265     }
1266 }
1267
1268 my $ret = system @ARGV;
1269
1270 report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
1271
1272 # Local variables:
1273 # cperl-indent-level: 4
1274 # indent-tabs-mode: nil
1275 # End:
1276 #
1277 # ex: set ts=8 sts=4 sw=4 et: