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