This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
4f36ebec48e5d01c367ff41af065506bc197dfe4
[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
6 my @targets = qw(config.sh config.h miniperl lib/Config.pm perl test_prep);
7
8 my %options =
9     (
10      jobs => 9,
11      'expect-pass' => 1,
12      clean => 1, # mostly for debugging this
13     );
14
15 my @paths = qw(/usr/local/lib64 /lib64 /usr/lib64);
16
17 my %defines =
18     (
19      usedevel => '',
20      optimize => '-g',
21      cc => 'ccache gcc',
22      ld => 'gcc',
23      'libpth' => \@paths,
24     );
25
26 sub usage {
27     die "$0: [--target=...] [-j4] [--expect-pass=0|1] thing to test";
28 }
29
30 unless(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',
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                   },
46                  )) {
47     usage();
48 }
49
50 my ($target, $j, $match) = @options{qw(target jobs match)};
51
52 usage() unless @ARGV || $match || $options{'test-build'}
53     || defined $options{'one-liner'};
54
55 exit 0 if $options{'check-args'};
56
57 die "$0: Can't build $target" if defined $target && !grep {@targets} $target;
58
59 $j = "-j$j" if $j =~ /\A\d+\z/;
60
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
66 sub 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
78 sub clean {
79     if ($options{clean}) {
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
89 sub skip {
90     my $reason = shift;
91     clean();
92     warn "skipping - $reason";
93     exit 125;
94 }
95
96 sub report_and_exit {
97     my ($ret, $pass, $fail, $desc) = @_;
98
99     clean();
100
101     my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad';
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
111 sub 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
143 sub apply_patch {
144     my $patch = shift;
145
146     my ($file) = $patch =~ qr!^diff.*a/(\S+) b/\1!;
147     open my $fh, '|-', 'patch' or die "Can't run patch: $!";
148     print $fh $patch;
149     close $fh or die "Can't patch $file: $?, $!";
150 }
151
152 # Not going to assume that system perl is yet new enough to have autodie
153 system 'git clean -dxf' and die;
154
155 if (!defined $target) {
156     match_and_exit() if $match;
157     $target = 'test_prep';
158 }
159
160 skip('no Configure - is this the //depot/perlext/Compiler branch?')
161     unless -f 'Configure';
162
163 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
164 my $major
165     = extract_from_file('patchlevel.h',
166                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
167                         0);
168
169 if ($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');
175 diff --git a/Configure b/Configure
176 index 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
189 EOPATCH
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');
200 diff --git a/Configure b/Configure
201 index 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
214 EOPATCH
215     }
216 }
217     
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
221 system 'git show blead:makedepend.SH > makedepend.SH' and die;
222
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.
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
238 unless (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     }
252     $defines{libs} = \@libs unless exists $defines{libs};
253 }
254
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.
257 $defines{trnl} = q{'\n'}
258     if $major < 4 && !exists $defines{trnl};
259
260 $defines{usenm} = undef
261     if $major < 2 && !exists $defines{usenm};
262
263 my (@missing, @created_dirs);
264
265 if ($options{'force-manifest'}) {
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
291 my @ARGS = $target eq 'config.sh' ? '-dEs' : '-des';
292 foreach 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 }
305 push @ARGS, map {"-A$_"} @{$options{A}};
306
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)
309 my $pid = fork;
310 die "Can't fork: $!" unless defined $pid;
311 if (!$pid) {
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
314     if($major > 4) {
315         open STDIN, '<', '/dev/null';
316     } elsif (!$options{'force-manifest'}) {
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     }
332     exec './Configure', @ARGS;
333     die "Failed to start Configure: $!";
334 }
335 waitpid $pid, 0
336     or die "wait for Configure, pid $pid failed: $!";
337
338 if ($target =~ /config\.s?h/) {
339     match_and_exit($target) if $match && -f $target;
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 }
346
347 # This is probably way too paranoid:
348 if (@missing) {
349     my @errors;
350     require Fcntl;
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         }
358         if (Fcntl::S_IMODE($mode) != 0) {
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     }
372     skip("@errors")
373         if @errors;
374 }
375
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 }
385
386 if ($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');
393 diff --git a/perl.c b/perl.c
394 index 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
437 EOPATCH
438 }
439
440 # Parallel build for miniperl is safe
441 system "make $j miniperl";
442
443 if ($target ne 'miniperl') {
444     # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
445     $j = '' if $major < 10;
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         }
455     }
456
457     system "make $j $target";
458 }
459
460 my $expected = $target =~ /^test/ ? 'perl' : $target;
461 my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;
462
463 if ($options{'test-build'}) {
464     report_and_exit($missing_target, 'could build', 'could not build', $target);
465 } elsif ($missing_target) {
466     skip("could not build $target");
467 }
468
469 match_and_exit($target) if $match;
470
471 if (defined $options{'one-liner'}) {
472     my $exe = $target ne 'miniperl' ? 'perl' : 'miniperl';
473     unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'};
474 }
475
476 # This is what we came here to run:
477 my $ret = system @ARGV;
478
479 report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
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: