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