This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Note in Porting/bisect.pl that its documentation is in bisect-runner.pl
[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
6a8dbfd7
NC
10my $start_time = time;
11
e295b7be
NC
12# The default, auto_abbrev will treat -e as an abbreviation of --end
13# Which isn't what we want.
14use Getopt::Long qw(:config pass_through no_auto_abbrev);
6a8dbfd7 15
195ed8b1 16my ($start, $end, $validate);
77ae6092 17unshift @ARGV, '--help' unless GetOptions('start=s' => \$start,
195ed8b1
NC
18 'end=s' => \$end,
19 validate => \$validate);
77ae6092 20
e2760528
NC
21@ARGV = ('--', 'sh', '-c', 'cd t && ./perl TEST base/*.t')
22 if $validate && !@ARGV;
23
77ae6092
NC
24my $runner = $0;
25$runner =~ s/bisect\.pl/bisect-runner.pl/;
26
27die "Can't find bisect runner $runner" unless -f $runner;
28
5842706e
NC
29{
30 my ($dev0, $ino0) = stat $0;
31 die "Can't stat $0: $!" unless defined $ino0;
32 my ($dev1, $ino1) = stat 'Porting/bisect.pl';
33 die "Can't run a bisect using the directory containing $runner"
34 if defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1;
35}
36
77ae6092 37system $^X, $runner, '--check-args', @ARGV and exit 255;
6a8dbfd7 38
4819dd2a
NC
39# We try these in this order for the start revision if none is specified.
40my @stable = qw(perl-5.002 perl-5.003 perl-5.004 perl-5.005 perl-5.6.0
41 perl-5.8.0 v5.10.0 v5.12.0 v5.14.0);
e295b7be 42
6a8dbfd7 43$end = 'blead' unless defined $end;
c382b335
NC
44
45# Canonicalising branches to revisions before moving the checkout permits one
46# to use revisions such as 'HEAD' for --start or --end
47foreach ($start, $end) {
48 next unless $_;
49 $_ = `git rev-parse $_`;
50 die unless defined $_;
51 chomp;
52}
6a8dbfd7
NC
53
54my $modified = () = `git ls-files --modified --deleted --others`;
55
56die "This checkout is not clean - $modified modified or untracked file(s)"
57 if $modified;
58
195ed8b1
NC
59sub validate {
60 my $commit = shift;
3f14869b
NC
61 if (defined $start && `git rev-list -n1 $commit ^$start^` eq "") {
62 print "Skipping $commit, as it is earlier than $start\n";
63 return;
64 }
65 if (defined $end && `git rev-list -n1 $end ^$commit^` eq "") {
66 print "Skipping $commit, as it is more recent than $end\n";
67 return;
68 }
195ed8b1
NC
69 print "Testing $commit...\n";
70 system "git checkout $commit </dev/null" and die;
71 my $ret = system $^X, $runner, '--no-clean', @ARGV;
72 die "Runner returned $ret, not 0 for revision $commit" if $ret;
73 system 'git clean -dxf </dev/null' and die;
74 system 'git reset --hard HEAD </dev/null' and die;
e2760528 75 return $commit;
195ed8b1
NC
76}
77
78if ($validate) {
e2760528
NC
79 require Text::Wrap;
80 my @built = map {validate $_} 'blead', reverse @stable;
81 if (@built) {
82 print Text::Wrap::wrap("", "", "Successfully validated @built\n");
83 exit 0;
84 }
85 print "Did not validate anything\n";
86 exit 1;
195ed8b1
NC
87}
88
c382b335
NC
89my $git_version = `git --version`;
90if (defined $git_version
91 && $git_version =~ /\Agit version (\d+\.\d+\.\d+)(.*)/) {
92 $git_version = eval "v$1";
93} else {
94 $git_version = v0.0.0;
95}
96
97if ($git_version ge v1.6.6) {
98 system "git bisect reset HEAD" and die;
99} else {
100 system "git bisect reset" and die;
101}
6a8dbfd7 102
6a8dbfd7 103# Sanity check the first and last revisions:
c382b335
NC
104system "git checkout $end" and die;
105my $ret = system $^X, $runner, @ARGV;
106die "Runner returned $ret for end revision" unless $ret;
107
4819dd2a
NC
108if (defined $start) {
109 system "git checkout $start" and die;
e295b7be 110 my $ret = system $^X, $runner, @ARGV;
4819dd2a
NC
111 die "Runner returned $ret, not 0 for start revision" if $ret;
112} else {
113 # Try to find the earliest version for which the test works
114 foreach my $try (@stable) {
115 system "git checkout $try" and die;
e295b7be 116 my $ret = system $^X, $runner, @ARGV;
4819dd2a
NC
117 if (!$ret) {
118 $start = $try;
119 last;
120 }
121 }
122 die "Can't find a suitable start revision to default to. Tried @stable"
123 unless defined $start;
124}
6a8dbfd7
NC
125
126system "git bisect start" and die;
127system "git bisect good $start" and die;
128system "git bisect bad $end" and die;
129
130# And now get git bisect to do the hard work:
e295b7be 131system 'git', 'bisect', 'run', $^X, $runner, @ARGV and die;
6a8dbfd7 132
c3d98a71
NC
133END {
134 my $end_time = time;
6a8dbfd7 135
c3d98a71
NC
136 printf "That took %d seconds\n", $end_time - $start_time
137 if defined $start_time;
138}
139
9b404864
NC
140=for comment
141
142Documentation for this is in bisect-runner.pl
143
144=cut
145
c3d98a71
NC
146# Local variables:
147# cperl-indent-level: 4
148# indent-tabs-mode: nil
149# End:
150#
151# ex: set ts=8 sts=4 sw=4 et: