This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add Porting/bisect.pl, to automate bisecting a perl code test case.
[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 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
14 sub usage {
15     die "$0: [--target=...] [-j=4] [--expect-pass=0|1] thing to test";
16 }
17
18 unless(GetOptions('target=s' => \$target,
19                   'jobs|j=i' => \$j,
20                   'expect-pass=i' => \$test_should_pass,
21                   'expect-fail' => sub { $test_should_pass = 0; },
22                   'clean!' => \$clean, # mostly for debugging this
23                   'one-liner|e=s' => \$one_liner,
24                  )) {
25     usage();
26 }
27
28 my $expected = $target eq 'miniperl' ? 'miniperl' : 'perl';
29
30 unshift @ARGV, "./$expected", '-e', $one_liner if defined $one_liner;
31
32 usage() unless @ARGV;
33
34 die "$0: Can't build $target" unless grep {@targets} $target;
35
36 $j = "-j$j" if $j =~ /\A\d+\z/;
37
38 sub extract_from_file {
39     my ($file, $rx, $default) = @_;
40     open my $fh, '<', $file or die "Can't open $file: $!";
41     while (<$fh>) {
42         my @got = $_ =~ $rx;
43         return wantarray ? @got : $got[0]
44             if @got;
45     }
46     return $default if defined $default;
47     return;
48 }
49
50 # Not going to assume that system perl is yet new enough to have autodie
51 system 'git clean -dxf' and die;
52
53 # There was a bug in makedepend.SH which was fixed in version 96a8704c.
54 # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
55 # Remove this if you're actually bisecting a problem related to makedepend.SH
56 system 'git show blead:makedepend.SH > makedepend.SH' and die;
57
58 my @paths = qw(/usr/local/lib64 /lib64 /usr/lib64);
59
60 # if Encode is not needed for the test, you can speed up the bisect by
61 # excluding it from the runs with -Dnoextensions=Encode
62 # ccache is an easy win. Remove it if it causes problems.
63 my @ARGS = ('-des', '-Dusedevel', '-Doptimize=-g', '-Dcc=ccache gcc',
64             '-Dld=gcc', "-Dlibpth=@paths");
65
66 # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
67 # to true in hints/linux.sh
68 # On dromedary, from that point on, Configure (by default) fails to find any
69 # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
70 # versioned libraries. Without -lm, the build fails.
71 # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
72 # until commit faae14e6e968e1c0 adds it to the hints.
73 # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
74 # because it will spot versioned libraries, pass them to the compiler, and then
75 # bail out pretty early on. Configure won't let us override libswanted, but it
76 # will let us override the entire libs list.
77
78 unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
79     # Before 1cfa4ec74d4933da, so force the libs list.
80
81     my @libs;
82     # This is the current libswanted list from Configure, less the libs removed
83     # by current hints/linux.sh
84     foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
85                         ld sun m crypt sec util c cposix posix ucb BSD)) {
86         foreach my $dir (@paths) {
87             next unless -f "$dir/lib$lib.so";
88             push @libs, "-l$lib";
89             last;
90         }
91     }
92     push @ARGS, "-Dlibs=@libs";
93 }
94
95 # </dev/null because it seems that some earlier versions of Configure can
96 # call commands in a way that now has them reading from stdin (and hanging)
97 my $pid = fork;
98 die "Can't fork: $!" unless defined $pid;
99 if (!$pid) {
100     open STDIN, '<', '/dev/null';
101     exec './Configure', @ARGS;
102     die "Failed to start Configure: $!";
103 }
104 waitpid $pid, 0
105     or die "wait for Configure, pid $pid failed: $!";
106
107 # Skip if something went wrong with Configure
108 unless (-f 'config.sh') {
109     warn "skipping - no config.sh";
110     exit 125;
111 }
112
113 # Correct makefile for newer GNU gcc
114 # Only really needed if you comment out the use of blead's makedepend.SH
115 {
116     local $^I = "";
117     local @ARGV = qw(makefile x2p/makefile);
118     while (<>) {
119         print unless /<(?:built-in|command|stdin)/;
120     }
121 }
122             
123 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
124 my $major
125     = extract_from_file('patchlevel.h',
126                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
127                         0);
128
129 # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
130 $j = '' unless $major > 10;
131
132 if ($target eq 'test_prep') {
133     if ($major < 8) {
134         # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
135         # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
136         # earlier than that, just make test. It will be fast enough.
137         $target = extract_from_file('Makefile.SH', qr/^(test[-_]prep):/, 'test');
138     }
139 }
140
141 system "make $j $target";
142
143 if (!-x $expected) {
144     warn "skipping - could not build $target";
145     exit 125;
146 }
147
148 # This is what we came here to run:
149 my $ret = system @ARGV;
150
151 if ($clean) {
152     # Needed, because files that are build products in this checked out version
153     # might be in git in the next desired version.
154     system 'git clean -dxf';
155     # Needed, because at some revisions the build alters checked out files.
156     # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
157     system 'git reset --hard HEAD';
158 }
159
160 my $got = ($test_should_pass ? !$ret : $ret) ? 'good' : 'bad';
161
162 if ($ret) {
163     print "$got - non-zero exit from @ARGV\n";
164 } else {
165     print "$got - zero exit from @ARGV\n";
166 }
167
168 exit($got eq 'bad');