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