This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
If patching fails, bisect-runner.pl should report the name of the file.
[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);
6a8dbfd7 5
dd4e46d7 6my @targets = qw(config.sh miniperl lib/Config.pm perl test_prep);
6a8dbfd7 7
f4800c99
NC
8my %options =
9 (
10 target => 'test_prep',
11 jobs => 9,
12 'expect-pass' => 1,
13 clean => 1, # mostly for debugging this
14 );
6a8dbfd7 15
390a69a9
NC
16my @paths = qw(/usr/local/lib64 /lib64 /usr/lib64);
17
18my %defines =
19 (
20 usedevel => '',
21 optimize => '-g',
22 cc => 'ccache gcc',
23 ld => 'gcc',
24 'libpth' => \@paths,
25 );
26
6a8dbfd7 27sub usage {
e295b7be 28 die "$0: [--target=...] [-j4] [--expect-pass=0|1] thing to test";
6a8dbfd7
NC
29}
30
f4800c99
NC
31unless(GetOptions(\%options,
32 'target=s', 'jobs|j=i', 'expect-pass=i',
33 'expect-fail' => sub { $options{'expect-pass'} = 0; },
34 'clean!', 'one-liner|e=s', 'match=s', 'force-manifest',
390a69a9
NC
35 'test-build', 'check-args', 'A=s@', 'verbose+',
36 'D=s@' => sub {
37 my (undef, $val) = @_;
38 if ($val =~ /\A([^=]+)=(.*)/s) {
39 $defines{$1} = length $2 ? $2 : "\0";
40 } else {
41 $defines{$val} = '';
42 }
43 },
44 'U=s@' => sub {
45 $defines{$_[1]} = undef;
46 },
6a8dbfd7
NC
47 )) {
48 usage();
49}
50
f4800c99 51my ($target, $j, $match) = @options{qw(target jobs match)};
e295b7be 52
4daf2803
NC
53my $exe = $target eq 'perl' || $target eq 'test_prep' ? 'perl' : 'miniperl';
54my $expected = $target eq 'test_prep' ? 'perl' : $target;
6a8dbfd7 55
f4800c99 56unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'}
390a69a9 57 if defined $options{'one-liner'};
6a8dbfd7 58
f4800c99
NC
59usage() unless @ARGV || $match || $options{'test-build'};
60exit 0 if $options{'check-args'};
6a8dbfd7
NC
61
62die "$0: Can't build $target" unless grep {@targets} $target;
63
64$j = "-j$j" if $j =~ /\A\d+\z/;
65
0142f0ce
NC
66# Sadly, however hard we try, I don't think that it will be possible to build
67# modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29,
68# which updated to MakeMaker 3.7, which changed from using a hard coded ld
69# in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc.
70
6a8dbfd7
NC
71sub extract_from_file {
72 my ($file, $rx, $default) = @_;
73 open my $fh, '<', $file or die "Can't open $file: $!";
74 while (<$fh>) {
75 my @got = $_ =~ $rx;
76 return wantarray ? @got : $got[0]
77 if @got;
78 }
79 return $default if defined $default;
80 return;
81}
82
ab4a15f9 83sub clean {
f4800c99 84 if ($options{clean}) {
ab4a15f9
NC
85 # Needed, because files that are build products in this checked out
86 # version might be in git in the next desired version.
87 system 'git clean -dxf';
88 # Needed, because at some revisions the build alters checked out files.
89 # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
90 system 'git reset --hard HEAD';
91 }
92}
93
94sub skip {
95 my $reason = shift;
96 clean();
97 warn "skipping - $reason";
98 exit 125;
99}
100
f1050811
NC
101sub report_and_exit {
102 my ($ret, $pass, $fail, $desc) = @_;
103
104 clean();
105
f4800c99 106 my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad';
f1050811
NC
107 if ($ret) {
108 print "$got - $fail $desc\n";
109 } else {
110 print "$got - $pass $desc\n";
111 }
112
113 exit($got eq 'bad');
114}
115
0142f0ce
NC
116sub apply_patch {
117 my $patch = shift;
118
f1193e4b 119 my ($file) = $patch =~ qr!^diff.*a/(\S+) b/\1!;
0142f0ce
NC
120 open my $fh, '|-', 'patch' or die "Can't run patch: $!";
121 print $fh $patch;
f1193e4b 122 close $fh or die "Can't patch $file: $?, $!";
0142f0ce
NC
123}
124
6a8dbfd7
NC
125# Not going to assume that system perl is yet new enough to have autodie
126system 'git clean -dxf' and die;
127
bc96a05a
NC
128if ($match) {
129 my $matches;
130 my $re = qr/$match/;
131 foreach my $file (`git ls-files`) {
132 chomp $file;
133 open my $fh, '<', $file or die "Can't open $file: $!";
134 while (<$fh>) {
135 if ($_ =~ $re) {
136 ++$matches;
137 $_ .= "\n" unless /\n\z/;
138 print "$file: $_";
139 }
140 }
141 close $fh or die "Can't close $file: $!";
142 }
143 report_and_exit(!$matches, 'matches for', 'no matches for', $match);
144}
145
4b081584
NC
146skip('no Configure - is this the //depot/perlext/Compiler branch?')
147 unless -f 'Configure';
148
dbcdc176
NC
149# This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
150my $major
151 = extract_from_file('patchlevel.h',
152 qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
153 0);
154
0142f0ce
NC
155if ($major < 1) {
156 if (extract_from_file('Configure',
157 qr/^ \*=\*\) echo "\$1" >> \$optdef;;$/)) {
158 # This is " Spaces now allowed in -D command line options.",
159 # part of commit ecfc54246c2a6f42
160 apply_patch(<<'EOPATCH');
161diff --git a/Configure b/Configure
162index 3d3b38d..78ffe16 100755
163--- a/Configure
164+++ b/Configure
165@@ -652,7 +777,8 @@ while test $# -gt 0; do
166 echo "$me: use '-U symbol=', not '-D symbol='." >&2
167 echo "$me: ignoring -D $1" >&2
168 ;;
169- *=*) echo "$1" >> $optdef;;
170+ *=*) echo "$1" | \
171+ sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;;
172 *) echo "$1='define'" >> $optdef;;
173 esac
174 shift
175EOPATCH
176 }
177 if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) {
178 # Configure's original simple "grep" for d_namlen falls foul of the
179 # approach taken by the glibc headers:
180 # #ifdef _DIRENT_HAVE_D_NAMLEN
181 # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen)
182 #
183 # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux.
184 # This is also part of commit ecfc54246c2a6f42
185 apply_patch(<<'EOPATCH');
186diff --git a/Configure b/Configure
187index 3d3b38d..78ffe16 100755
188--- a/Configure
189+++ b/Configure
190@@ -3935,7 +4045,8 @@ $rm -f try.c
191
192 : see if the directory entry stores field length
193 echo " "
194-if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
195+$cppstdin $cppflags $cppminus < "$xinc" > try.c
196+if $contains 'd_namlen' try.c >/dev/null 2>&1; then
197 echo "Good, your directory entry keeps length information in d_namlen." >&4
198 val="$define"
199 else
200EOPATCH
201 }
202}
203
6a8dbfd7
NC
204# There was a bug in makedepend.SH which was fixed in version 96a8704c.
205# Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
206# Remove this if you're actually bisecting a problem related to makedepend.SH
207system 'git show blead:makedepend.SH > makedepend.SH' and die;
208
6a8dbfd7
NC
209# if Encode is not needed for the test, you can speed up the bisect by
210# excluding it from the runs with -Dnoextensions=Encode
211# ccache is an easy win. Remove it if it causes problems.
6a8dbfd7
NC
212# Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
213# to true in hints/linux.sh
214# On dromedary, from that point on, Configure (by default) fails to find any
215# libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
216# versioned libraries. Without -lm, the build fails.
217# Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
218# until commit faae14e6e968e1c0 adds it to the hints.
219# However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
220# because it will spot versioned libraries, pass them to the compiler, and then
221# bail out pretty early on. Configure won't let us override libswanted, but it
222# will let us override the entire libs list.
223
224unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
225 # Before 1cfa4ec74d4933da, so force the libs list.
226
227 my @libs;
228 # This is the current libswanted list from Configure, less the libs removed
229 # by current hints/linux.sh
230 foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
231 ld sun m crypt sec util c cposix posix ucb BSD)) {
232 foreach my $dir (@paths) {
233 next unless -f "$dir/lib$lib.so";
234 push @libs, "-l$lib";
235 last;
236 }
237 }
390a69a9 238 $defines{libs} = \@libs unless exists $defines{libs};
6a8dbfd7
NC
239}
240
4b081584
NC
241# This seems to be necessary to avoid makedepend becoming confused, and hanging
242# on stdin. Seems that the code after make shlist || ...here... is never run.
390a69a9
NC
243$defines{trnl} = q{'\n'}
244 if $major < 4 && !exists $defines{trnl};
4b081584 245
390a69a9
NC
246$defines{usenm} = undef
247 if $major < 2 && !exists $defines{usenm};
0142f0ce 248
67382a3b
NC
249my (@missing, @created_dirs);
250
f4800c99 251if ($options{'force-manifest'}) {
67382a3b
NC
252 open my $fh, '<', 'MANIFEST'
253 or die "Could not open MANIFEST: $!";
254 while (<$fh>) {
255 next unless /^(\S+)/;
256 push @missing, $1
257 unless -f $1;
258 }
259 close $fh or die "Can't close MANIFEST: $!";
260
261 foreach my $pathname (@missing) {
262 my @parts = split '/', $pathname;
263 my $leaf = pop @parts;
264 my $path = '.';
265 while (@parts) {
266 $path .= '/' . shift @parts;
267 next if -d $path;
268 mkdir $path, 0700 or die "Can't create $path: $!";
269 unshift @created_dirs, $path;
270 }
271 open $fh, '>', $pathname or die "Can't open $pathname: $!";
272 close $fh or die "Can't close $pathname: $!";
273 chmod 0, $pathname or die "Can't chmod 0 $pathname: $!";
274 }
275}
276
dd4e46d7 277my @ARGS = $target eq 'config.sh' ? '-dEs' : '-des';
390a69a9
NC
278foreach my $key (sort keys %defines) {
279 my $val = $defines{$key};
280 if (ref $val) {
281 push @ARGS, "-D$key=@$val";
282 } elsif (!defined $val) {
283 push @ARGS, "-U$key";
284 } elsif (!length $val) {
285 push @ARGS, "-D$key";
286 } else {
287 $val = "" if $val eq "\0";
288 push @ARGS, "-D$key=$val";
289 }
290}
291push @ARGS, map {"-A$_"} @{$options{A}};
292
6a8dbfd7
NC
293# </dev/null because it seems that some earlier versions of Configure can
294# call commands in a way that now has them reading from stdin (and hanging)
295my $pid = fork;
296die "Can't fork: $!" unless defined $pid;
297if (!$pid) {
dbcdc176
NC
298 # Before dfe9444ca7881e71, Configure would refuse to run if stdin was not a
299 # tty. With that commit, the tty requirement was dropped for -de and -dE
8754c3bb 300 if($major > 4) {
67382a3b 301 open STDIN, '<', '/dev/null';
f4800c99 302 } elsif (!$options{'force-manifest'}) {
8754c3bb
NC
303 # If a file in MANIFEST is missing, Configure asks if you want to
304 # continue (the default being 'n'). With stdin closed or /dev/null,
305 # it exit immediately and the check for config.sh below will skip.
306 # To avoid a hang, we need to check MANIFEST for ourselves, and skip
307 # if anything is missing.
308 open my $fh, '<', 'MANIFEST';
309 skip("Could not open MANIFEST: $!")
310 unless $fh;
311 while (<$fh>) {
312 next unless /^(\S+)/;
313 skip("$1 from MANIFEST doesn't exist")
314 unless -f $1;
315 }
316 close $fh or die "Can't close MANIFEST: $!";
317 }
6a8dbfd7
NC
318 exec './Configure', @ARGS;
319 die "Failed to start Configure: $!";
320}
321waitpid $pid, 0
322 or die "wait for Configure, pid $pid failed: $!";
323
dd4e46d7
NC
324if ($target eq 'config.sh') {
325 report_and_exit(!-f $target, 'could build', 'could not build', $target);
326} elsif (!-f 'config.sh') {
327 # Skip if something went wrong with Configure
328
329 skip('could not build config.sh');
330}
6a8dbfd7 331
67382a3b
NC
332# This is probably way too paranoid:
333if (@missing) {
334 my @errors;
eb4906f4 335 require Fcntl;
67382a3b
NC
336 foreach my $file (@missing) {
337 my (undef, undef, $mode, undef, undef, undef, undef, $size)
338 = stat $file;
339 if (!defined $mode) {
340 push @errors, "Added file $file has been deleted by Configure";
341 next;
342 }
eb4906f4 343 if (Fcntl::S_IMODE($mode) != 0) {
67382a3b
NC
344 push @errors,
345 sprintf 'Added file %s had mode changed by Configure to %03o',
346 $file, $mode;
347 }
348 if ($size != 0) {
349 push @errors,
350 "Added file $file had sized changed by Configure to $size";
351 }
352 unlink $file or die "Can't unlink $file: $!";
353 }
354 foreach my $dir (@created_dirs) {
355 rmdir $dir or die "Can't rmdir $dir: $!";
356 }
6c0925a0
NC
357 skip("@errors")
358 if @errors;
67382a3b
NC
359}
360
6a8dbfd7
NC
361# Correct makefile for newer GNU gcc
362# Only really needed if you comment out the use of blead's makedepend.SH
363{
364 local $^I = "";
365 local @ARGV = qw(makefile x2p/makefile);
366 while (<>) {
367 print unless /<(?:built-in|command|stdin)/;
368 }
369}
6a8dbfd7 370
0142f0ce
NC
371if ($major == 2 && extract_from_file('perl.c', qr/^ fclose\(e_fp\);$/)) {
372 # need to patch perl.c to avoid calling fclose() twice on e_fp when using -e
373 # This diff is part of commit ab821d7fdc14a438. The second close was
374 # introduced with perl-5.002, commit a5f75d667838e8e7
375 # Might want a6c477ed8d4864e6 too, for the corresponding change to pp_ctl.c
376 # (likely without this, eval will have "fun")
377 apply_patch(<<'EOPATCH');
378diff --git a/perl.c b/perl.c
379index 03c4d48..3c814a2 100644
380--- a/perl.c
381+++ b/perl.c
382@@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
383 #ifndef VMS /* VMS doesn't have environ array */
384 origenviron = environ;
385 #endif
386+ e_tmpname = Nullch;
387
388 if (do_undump) {
389
390@@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
391 if (e_fp) {
392 if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
393 croak("Can't write to temp file for -e: %s", Strerror(errno));
394+ e_fp = Nullfp;
395 argc++,argv--;
396 scriptname = e_tmpname;
397 }
398@@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
399 curcop->cop_line = 0;
400 curstash = defstash;
401 preprocess = FALSE;
402- if (e_fp) {
403- fclose(e_fp);
404- e_fp = Nullfp;
405+ if (e_tmpname) {
406 (void)UNLINK(e_tmpname);
407+ Safefree(e_tmpname);
408+ e_tmpname = Nullch;
409 }
410
411 /* now that script is parsed, we can modify record separator */
412@@ -1369,7 +1371,7 @@ SV *sv;
413 scriptname = xfound;
414 }
415
416- origfilename = savepv(e_fp ? "-e" : scriptname);
417+ origfilename = savepv(e_tmpname ? "-e" : scriptname);
418 curcop->cop_filegv = gv_fetchfile(origfilename);
419 if (strEQ(origfilename,"-"))
420 scriptname = "";
421
422EOPATCH
423}
424
9a999a97
NC
425# Parallel build for miniperl is safe
426system "make $j miniperl";
427
428if ($target ne 'miniperl') {
429 # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
430 $j = '' unless $major > 10;
431
432 if ($target eq 'test_prep') {
433 if ($major < 8) {
434 # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
435 # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
436 # earlier than that, just make test. It will be fast enough.
437 $target = extract_from_file('Makefile.SH', qr/^(test[-_]prep):/,
438 'test');
439 }
6a8dbfd7 440 }
6a8dbfd7 441
9a999a97
NC
442 system "make $j $target";
443}
6a8dbfd7 444
67382a3b
NC
445my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;
446
f4800c99 447if ($options{'test-build'}) {
67382a3b
NC
448 report_and_exit($missing_target, 'could build', 'could not build', $target);
449} elsif ($missing_target) {
450 skip("could not build $target");
451}
6a8dbfd7
NC
452
453# This is what we came here to run:
454my $ret = system @ARGV;
455
f1050811 456report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
9a999a97
NC
457
458# Local variables:
459# cperl-indent-level: 4
460# indent-tabs-mode: nil
461# End:
462#
463# ex: set ts=8 sts=4 sw=4 et: