This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
If there is no 'blead' branch, bisect.pl now uses a suitable alternative.
[perl5.git] / Porting / bisect.pl
CommitLineData
6a8dbfd7
NC
1#!/usr/bin/perl -w
2use strict;
3
9b404864
NC
4=for comment
5
6Documentation for this is in bisect-runner.pl
7
8=cut
9
e295b7be
NC
10# The default, auto_abbrev will treat -e as an abbreviation of --end
11# Which isn't what we want.
12use Getopt::Long qw(:config pass_through no_auto_abbrev);
6a8dbfd7 13
02b83d1d 14my ($start, $end, $validate, $usage, $bad, $jobs, $make, $gold);
d3232d34 15$bad = !GetOptions('start=s' => \$start, 'end=s' => \$end,
02b83d1d 16 'jobs|j=i' => \$jobs, 'make=s' => \$make, 'gold=s' => \$gold,
0ed3b851
NC
17 validate => \$validate, 'usage|help|?' => \$usage);
18unshift @ARGV, '--help' if $bad || $usage;
b826a648 19unshift @ARGV, '--validate' if $validate;
e2760528 20
77ae6092
NC
21my $runner = $0;
22$runner =~ s/bisect\.pl/bisect-runner.pl/;
23
24die "Can't find bisect runner $runner" unless -f $runner;
25
0ed3b851
NC
26system $^X, $runner, '--check-args', '--check-shebang', @ARGV and exit 255;
27exit 255 if $bad;
28exit 0 if $usage;
29
5842706e
NC
30{
31 my ($dev0, $ino0) = stat $0;
32 die "Can't stat $0: $!" unless defined $ino0;
33 my ($dev1, $ino1) = stat 'Porting/bisect.pl';
34 die "Can't run a bisect using the directory containing $runner"
35 if defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1;
36}
37
0ed3b851 38my $start_time = time;
6a8dbfd7 39
d3232d34
NC
40if (!defined $jobs &&
41 !($^O eq 'hpux' && system((defined $make ? $make : 'make')
42 . ' --version >/dev/null 2>&1'))) {
0bc550ba
NC
43 # Try to default to (ab)use all the CPUs:
44 my $cpus;
45 if (open my $fh, '<', '/proc/cpuinfo') {
46 while (<$fh>) {
47 ++$cpus if /^processor\s+:\s+\d+$/;
48 }
49 } elsif (-x '/sbin/sysctl') {
50 $cpus = $1 if `/sbin/sysctl hw.ncpu` =~ /^hw\.ncpu: (\d+)$/;
51 } elsif (-x '/usr/bin/getconf') {
52 $cpus = $1 if `/usr/bin/getconf _NPROCESSORS_ONLN` =~ /^(\d+)$/;
53 }
54 $jobs = defined $cpus ? $cpus + 1 : 2;
55}
56
d3232d34
NC
57unshift @ARGV, '--jobs', $jobs if defined $jobs;
58unshift @ARGV, '--make', $make if defined $make;
0bc550ba 59
4819dd2a 60# We try these in this order for the start revision if none is specified.
f66c64b1
NC
61my @stable = map {chomp $_; $_} grep {/v5\.[0-9]+[02468]\.0$/} `git tag -l`;
62die "git tag -l didn't seem to return any tags for stable releases"
63 unless @stable;
64unshift @stable, qw(perl-5.005 perl-5.6.0 perl-5.8.0);
3ffe2687
NC
65
66{
67 my ($dev_C, $ino_C) = stat 'Configure';
68 my ($dev_c, $ino_c) = stat 'configure';
69 if (defined $dev_C && defined $dev_c
70 && $dev_C == $dev_c && $ino_C == $ino_c) {
eef6290d 71 print "You seem to be on a case-insensitive file system.\n\n";
3ffe2687
NC
72 } else {
73 unshift @stable, qw(perl-5.002 perl-5.003 perl-5.004)
74 }
75}
e295b7be 76
02b83d1d
NC
77unshift @ARGV, '--gold', defined $gold ? $gold : $stable[-1];
78
7f39e2df
NC
79if (!defined $end) {
80 # If we have a branch blead, use that as the end
81 $end = `git rev-parse --verify --quiet blead`;
82 die unless defined $end;
83 if (!length $end) {
84 # Else use whichever is newer - HEAD, or the most recent stable tag.
85 if (`git rev-list -n1 HEAD ^$stable[-1]` eq "") {
86 $end = pop @stable;
87 } else {
88 $end = 'HEAD';
89 }
90 }
91}
c382b335
NC
92
93# Canonicalising branches to revisions before moving the checkout permits one
94# to use revisions such as 'HEAD' for --start or --end
95foreach ($start, $end) {
96 next unless $_;
97 $_ = `git rev-parse $_`;
98 die unless defined $_;
99 chomp;
100}
6a8dbfd7 101
b835daeb 102my $modified = my @modified = `git ls-files --modified --deleted --others`;
6a8dbfd7 103
b835daeb
YO
104die "This checkout is not clean, found file(s):\n",
105 join("\t","",@modified),
106 "$modified modified, untracked, or other file(s)\n",
107 "These files may not show in git status as they may be ignored.\n",
108 "You can use 'git clean -Xdf' to cleanup the ignored files.\n"
6a8dbfd7
NC
109 if $modified;
110
195ed8b1
NC
111sub validate {
112 my $commit = shift;
3f14869b
NC
113 if (defined $start && `git rev-list -n1 $commit ^$start^` eq "") {
114 print "Skipping $commit, as it is earlier than $start\n";
115 return;
116 }
117 if (defined $end && `git rev-list -n1 $end ^$commit^` eq "") {
118 print "Skipping $commit, as it is more recent than $end\n";
119 return;
120 }
195ed8b1
NC
121 print "Testing $commit...\n";
122 system "git checkout $commit </dev/null" and die;
123 my $ret = system $^X, $runner, '--no-clean', @ARGV;
124 die "Runner returned $ret, not 0 for revision $commit" if $ret;
125 system 'git clean -dxf </dev/null' and die;
126 system 'git reset --hard HEAD </dev/null' and die;
e2760528 127 return $commit;
195ed8b1
NC
128}
129
130if ($validate) {
e2760528
NC
131 require Text::Wrap;
132 my @built = map {validate $_} 'blead', reverse @stable;
133 if (@built) {
134 print Text::Wrap::wrap("", "", "Successfully validated @built\n");
135 exit 0;
136 }
137 print "Did not validate anything\n";
138 exit 1;
195ed8b1
NC
139}
140
c382b335
NC
141my $git_version = `git --version`;
142if (defined $git_version
143 && $git_version =~ /\Agit version (\d+\.\d+\.\d+)(.*)/) {
144 $git_version = eval "v$1";
145} else {
146 $git_version = v0.0.0;
147}
148
149if ($git_version ge v1.6.6) {
150 system "git bisect reset HEAD" and die;
151} else {
152 system "git bisect reset" and die;
153}
6a8dbfd7 154
6a8dbfd7 155# Sanity check the first and last revisions:
c382b335
NC
156system "git checkout $end" and die;
157my $ret = system $^X, $runner, @ARGV;
158die "Runner returned $ret for end revision" unless $ret;
a84ce349
NC
159die "Runner returned $ret for end revision, which is a skip"
160 if $ret == 125 * 256;
c382b335 161
4819dd2a
NC
162if (defined $start) {
163 system "git checkout $start" and die;
e295b7be 164 my $ret = system $^X, $runner, @ARGV;
4819dd2a
NC
165 die "Runner returned $ret, not 0 for start revision" if $ret;
166} else {
167 # Try to find the earliest version for which the test works
03cc0342 168 my @tried;
4819dd2a 169 foreach my $try (@stable) {
03cc0342
NC
170 if (`git rev-list -n1 $end ^$try^` eq "") {
171 print "Skipping $try, as it is more recent than end commit "
172 . (substr $end, 0, 16) . "\n";
173 # As @stable is supposed to be in age order, arguably we should
174 # last; here.
175 next;
176 }
4819dd2a 177 system "git checkout $try" and die;
e295b7be 178 my $ret = system $^X, $runner, @ARGV;
4819dd2a
NC
179 if (!$ret) {
180 $start = $try;
181 last;
182 }
03cc0342 183 push @tried, $try;
4819dd2a 184 }
03cc0342 185 die "Can't find a suitable start revision to default to.\nTried @tried"
4819dd2a
NC
186 unless defined $start;
187}
6a8dbfd7
NC
188
189system "git bisect start" and die;
190system "git bisect good $start" and die;
191system "git bisect bad $end" and die;
192
193# And now get git bisect to do the hard work:
e295b7be 194system 'git', 'bisect', 'run', $^X, $runner, @ARGV and die;
6a8dbfd7 195
c3d98a71
NC
196END {
197 my $end_time = time;
6a8dbfd7 198
c3d98a71
NC
199 printf "That took %d seconds\n", $end_time - $start_time
200 if defined $start_time;
201}
202
9b404864
NC
203=for comment
204
205Documentation for this is in bisect-runner.pl
206
207=cut
208
c3d98a71
NC
209# Local variables:
210# cperl-indent-level: 4
211# indent-tabs-mode: nil
212# End:
213#
214# ex: set ts=8 sts=4 sw=4 et: