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
1 #!/usr/bin/perl -w
2 use strict;
3
4 =for comment
5
6 Documentation for this is in bisect-runner.pl
7
8 =cut
9
10 my $start_time = time;
11
12 # The default, auto_abbrev will treat -e as an abbreviation of --end
13 # Which isn't what we want.
14 use Getopt::Long qw(:config pass_through no_auto_abbrev);
15
16 my ($start, $end, $validate);
17 unshift @ARGV, '--help' unless GetOptions('start=s' => \$start,
18                                           'end=s' => \$end,
19                                           validate => \$validate);
20
21 @ARGV = ('--', 'sh', '-c', 'cd t && ./perl TEST base/*.t')
22     if $validate && !@ARGV;
23
24 my $runner = $0;
25 $runner =~ s/bisect\.pl/bisect-runner.pl/;
26
27 die "Can't find bisect runner $runner" unless -f $runner;
28
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
37 system $^X, $runner, '--check-args', @ARGV and exit 255;
38
39 # We try these in this order for the start revision if none is specified.
40 my @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);
42
43 $end = 'blead' unless defined $end;
44
45 # Canonicalising branches to revisions before moving the checkout permits one
46 # to use revisions such as 'HEAD' for --start or --end
47 foreach ($start, $end) {
48     next unless $_;
49     $_ = `git rev-parse $_`;
50     die unless defined $_;
51     chomp;
52 }
53
54 my $modified = () = `git ls-files --modified --deleted --others`;
55
56 die "This checkout is not clean - $modified modified or untracked file(s)"
57     if $modified;
58
59 sub validate {
60     my $commit = shift;
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     }
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;
75     return $commit;
76 }
77
78 if ($validate) {
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;
87 }
88
89 my $git_version = `git --version`;
90 if (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
97 if ($git_version ge v1.6.6) {
98     system "git bisect reset HEAD" and die;
99 } else {
100     system "git bisect reset" and die;
101 }
102
103 # Sanity check the first and last revisions:
104 system "git checkout $end" and die;
105 my $ret = system $^X, $runner, @ARGV;
106 die "Runner returned $ret for end revision" unless $ret;
107
108 if (defined $start) {
109     system "git checkout $start" and die;
110     my $ret = system $^X, $runner, @ARGV;
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;
116         my $ret = system $^X, $runner, @ARGV;
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 }
125
126 system "git bisect start" and die;
127 system "git bisect good $start" and die;
128 system "git bisect bad $end" and die;
129
130 # And now get git bisect to do the hard work:
131 system 'git', 'bisect', 'run', $^X, $runner, @ARGV and die;
132
133 END {
134     my $end_time = time;
135
136     printf "That took %d seconds\n", $end_time - $start_time
137         if defined $start_time;
138 }
139
140 =for comment
141
142 Documentation for this is in bisect-runner.pl
143
144 =cut
145
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: