This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In bisect.pl, use the earliest passing stable perl as the default revision.
[perl5.git] / Porting / bisect.pl
1 #!/usr/bin/perl -w
2 use strict;
3
4 my $start_time = time;
5
6 use Getopt::Long;
7
8 sub usage {
9     die "$0: [--start revlike] [--end revlike] [--target=...] [-j=4] [--expect-pass=0|1] thing to test";
10 }
11
12 my %options;
13 unless(GetOptions(\%options,
14                   'start=s',
15                   'end=s',
16                   'target=s',
17                   'jobs|j=i',
18                   'expect-pass=i',
19                   'expect-fail',
20                   'one-liner|e=s',
21                   'match=s',
22                   'force-manifest',
23                   'test-build',
24                  )) {
25     usage();
26 }
27
28 foreach (qw(force-manifest test-build)) {
29     # This is a bodge. I can't see a clean way to pass through suitably exact
30     # strings the various arguments to bisect-runner.pl that are argument-less
31     # flags. It might be easier for this program not to use Getopt::Long, and
32     # instead just grep out --start and --end
33     undef $options{$_} if exists $options{$_};
34 }
35
36 # We try these in this order for the start revision if none is specified.
37 my @stable = qw(perl-5.002 perl-5.003 perl-5.004 perl-5.005 perl-5.6.0
38                 perl-5.8.0 v5.10.0 v5.12.0 v5.14.0);
39 my $start = delete $options{start};
40 if ($start) {
41     system "git rev-parse $start >/dev/null" and die;
42 }
43 my $end = delete $options{end};
44 $end = 'blead' unless defined $end;
45
46 system "git rev-parse $end >/dev/null" and die;
47
48 my $modified = () = `git ls-files --modified --deleted --others`;
49
50 die "This checkout is not clean - $modified modified or untracked file(s)"
51     if $modified;
52
53 system "git bisect reset" and die;
54
55 my @ARGS;
56 foreach (sort keys %options) {
57     push @ARGS, defined $options{$_} ? "--$_=$options{$_}" : "--$_";
58 }
59 push @ARGS, @ARGV;
60
61 my $runner = $0;
62 $runner =~ s/bisect\.pl/bisect-runner.pl/;
63
64 die "Can't find bisect runner $runner" unless -f $runner;
65
66 # Sanity check the first and last revisions:
67 if (defined $start) {
68     system "git checkout $start" and die;
69     my $ret = system $^X, $runner, @ARGS;
70     die "Runner returned $ret, not 0 for start revision" if $ret;
71 } else {
72     # Try to find the earliest version for which the test works
73     foreach my $try (@stable) {
74         system "git checkout $try" and die;
75         my $ret = system $^X, $runner, @ARGS;
76         if (!$ret) {
77             $start = $try;
78             last;
79         }
80     }
81     die "Can't find a suitable start revision to default to. Tried @stable"
82         unless defined $start;
83 }
84 system "git checkout $end" and die;
85 my $ret = system $^X, $runner, @ARGS;
86 die "Runner returned $ret for end revision" unless $ret;
87
88 system "git bisect start" and die;
89 system "git bisect good $start" and die;
90 system "git bisect bad $end" and die;
91
92 # And now get git bisect to do the hard work:
93 system 'git', 'bisect', 'run', $^X, $runner, @ARGS and die;
94
95 END {
96     my $end_time = time;
97
98     printf "That took %d seconds\n", $end_time - $start_time
99         if defined $start_time;
100 }
101
102 # Local variables:
103 # cperl-indent-level: 4
104 # indent-tabs-mode: nil
105 # End:
106 #
107 # ex: set ts=8 sts=4 sw=4 et: