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
CommitLineData
6a8dbfd7
NC
1#!/usr/bin/perl -w
2use strict;
3
4my $start_time = time;
5
6use Getopt::Long;
7
8sub usage {
9 die "$0: [--start revlike] [--end revlike] [--target=...] [-j=4] [--expect-pass=0|1] thing to test";
10}
11
12my %options;
13unless(GetOptions(\%options,
c3d98a71
NC
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',
bc96a05a 21 'match=s',
67382a3b
NC
22 'force-manifest',
23 'test-build',
c3d98a71 24 )) {
6a8dbfd7
NC
25 usage();
26}
27
67382a3b
NC
28foreach (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
4819dd2a
NC
36# We try these in this order for the start revision if none is specified.
37my @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);
6a8dbfd7 39my $start = delete $options{start};
4819dd2a
NC
40if ($start) {
41 system "git rev-parse $start >/dev/null" and die;
42}
6a8dbfd7
NC
43my $end = delete $options{end};
44$end = 'blead' unless defined $end;
45
6a8dbfd7
NC
46system "git rev-parse $end >/dev/null" and die;
47
48my $modified = () = `git ls-files --modified --deleted --others`;
49
50die "This checkout is not clean - $modified modified or untracked file(s)"
51 if $modified;
52
53system "git bisect reset" and die;
54
55my @ARGS;
56foreach (sort keys %options) {
57 push @ARGS, defined $options{$_} ? "--$_=$options{$_}" : "--$_";
58}
59push @ARGS, @ARGV;
60
61my $runner = $0;
62$runner =~ s/bisect\.pl/bisect-runner.pl/;
63
64die "Can't find bisect runner $runner" unless -f $runner;
65
66# Sanity check the first and last revisions:
4819dd2a
NC
67if (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}
6a8dbfd7 84system "git checkout $end" and die;
4819dd2a 85my $ret = system $^X, $runner, @ARGS;
6a8dbfd7
NC
86die "Runner returned $ret for end revision" unless $ret;
87
88system "git bisect start" and die;
89system "git bisect good $start" and die;
90system "git bisect bad $end" and die;
91
92# And now get git bisect to do the hard work:
93system 'git', 'bisect', 'run', $^X, $runner, @ARGS and die;
94
c3d98a71
NC
95END {
96 my $end_time = time;
6a8dbfd7 97
c3d98a71
NC
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: