This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
99aa56fbfc23cb7ad976d8e147b75a29a584c541
[perl5.git] / Porting / bisect-runner.pl
1 #!/usr/bin/perl -w
2 use strict;
3
4 use Getopt::Long qw(:config bundling);
5
6 my @targets = qw(miniperl lib/Config.pm perl test_prep);
7
8 my %options =
9     (
10      target => 'test_prep',
11      jobs => 9,
12      'expect-pass' => 1,
13      clean => 1, # mostly for debugging this
14     );
15
16 sub usage {
17     die "$0: [--target=...] [-j4] [--expect-pass=0|1] thing to test";
18 }
19
20 unless(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',
25                  )) {
26     usage();
27 }
28
29 my ($target, $j, $match) = @options{qw(target jobs match)};
30
31 my $exe = $target eq 'perl' || $target eq 'test_prep' ? 'perl' : 'miniperl';
32 my $expected = $target eq 'test_prep' ? 'perl' : $target;
33
34 unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'}
35     if $options{'one-liner'};
36
37 usage() unless @ARGV || $match || $options{'test-build'};
38 exit 0 if $options{'check-args'};
39
40 die "$0: Can't build $target" unless grep {@targets} $target;
41
42 $j = "-j$j" if $j =~ /\A\d+\z/;
43
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
49 sub 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
61 sub clean {
62     if ($options{clean}) {
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
72 sub skip {
73     my $reason = shift;
74     clean();
75     warn "skipping - $reason";
76     exit 125;
77 }
78
79 sub report_and_exit {
80     my ($ret, $pass, $fail, $desc) = @_;
81
82     clean();
83
84     my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad';
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
94 sub 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
102 # Not going to assume that system perl is yet new enough to have autodie
103 system 'git clean -dxf' and die;
104
105 if ($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
123 skip('no Configure - is this the //depot/perlext/Compiler branch?')
124     unless -f 'Configure';
125
126 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
127 my $major
128     = extract_from_file('patchlevel.h',
129                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
130                         0);
131
132 if ($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');
138 diff --git a/Configure b/Configure
139 index 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
152 EOPATCH
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');
163 diff --git a/Configure b/Configure
164 index 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
177 EOPATCH
178     }
179 }
180     
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
184 system 'git show blead:makedepend.SH > makedepend.SH' and die;
185
186 my @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.
191 my @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
206 unless (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
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.
225 push @ARGS, q{-Dtrnl='\n'}
226     if $major < 4;
227
228 push @ARGS, '-Uusenm'
229     if $major < 2;
230
231 my (@missing, @created_dirs);
232
233 if ($options{'force-manifest'}) {
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
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)
261 my $pid = fork;
262 die "Can't fork: $!" unless defined $pid;
263 if (!$pid) {
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
266     if($major > 4) {
267         open STDIN, '<', '/dev/null';
268     } elsif (!$options{'force-manifest'}) {
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     }
284     exec './Configure', @ARGS;
285     die "Failed to start Configure: $!";
286 }
287 waitpid $pid, 0
288     or die "wait for Configure, pid $pid failed: $!";
289
290 # Skip if something went wrong with Configure
291 skip('no config.sh') unless -f 'config.sh';
292
293 # This is probably way too paranoid:
294 if (@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     }
317     skip("@errors")
318         if @errors;
319 }
320
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 }
330
331 if ($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');
338 diff --git a/perl.c b/perl.c
339 index 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
382 EOPATCH
383 }
384
385 # Parallel build for miniperl is safe
386 system "make $j miniperl";
387
388 if ($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         }
400     }
401
402     system "make $j $target";
403 }
404
405 my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;
406
407 if ($options{'test-build'}) {
408     report_and_exit($missing_target, 'could build', 'could not build', $target);
409 } elsif ($missing_target) {
410     skip("could not build $target");
411 }
412
413 # This is what we came here to run:
414 my $ret = system @ARGV;
415
416 report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
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: