This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
7c0ba07eda56aaf31d0cc44fa4cfa82fe9b4bd8e
[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 # The default, auto_abbrev will treat -e as an abbreviation of --end
11 # Which isn't what we want.
12 use Getopt::Long qw(:config pass_through no_auto_abbrev);
13
14 my ($start, $end, $validate, $usage, $bad, $jobs);
15 $bad = !GetOptions('start=s' => \$start, 'end=s' => \$end, 'jobs|j=i' => \$jobs,
16                    validate => \$validate, 'usage|help|?' => \$usage);
17 unshift @ARGV, '--help' if $bad || $usage;
18 unshift @ARGV, '--validate' if $validate;
19
20 my $runner = $0;
21 $runner =~ s/bisect\.pl/bisect-runner.pl/;
22
23 die "Can't find bisect runner $runner" unless -f $runner;
24
25 system $^X, $runner, '--check-args', '--check-shebang', @ARGV and exit 255;
26 exit 255 if $bad;
27 exit 0 if $usage;
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 my $start_time = time;
38
39 if (!defined $jobs) {
40     # Try to default to (ab)use all the CPUs:
41     my $cpus;
42     if (open my $fh, '<', '/proc/cpuinfo') {
43         while (<$fh>) {
44             ++$cpus if /^processor\s+:\s+\d+$/;
45         }
46     } elsif (-x '/sbin/sysctl') {
47         $cpus =  $1 if `/sbin/sysctl hw.ncpu` =~ /^hw\.ncpu: (\d+)$/;
48     } elsif (-x '/usr/bin/getconf') {
49         $cpus = $1 if `/usr/bin/getconf _NPROCESSORS_ONLN` =~ /^(\d+)$/;
50     }
51     $jobs = defined $cpus ? $cpus + 1 : 2;
52 }
53
54 unshift @ARGV, '--jobs', $jobs;
55
56 # We try these in this order for the start revision if none is specified.
57 my @stable = qw(perl-5.005 perl-5.6.0 perl-5.8.0 v5.10.0 v5.12.0 v5.14.0);
58
59 {
60     my ($dev_C, $ino_C) = stat 'Configure';
61     my ($dev_c, $ino_c) = stat 'configure';
62     if (defined $dev_C && defined $dev_c
63         && $dev_C == $dev_c && $ino_C == $ino_c) {
64         print "You seem to be on a case-insensitive file system.\n\n";
65     } else {
66         unshift @stable, qw(perl-5.002 perl-5.003 perl-5.004)
67     }
68 }
69
70 $end = 'blead' unless defined $end;
71
72 # Canonicalising branches to revisions before moving the checkout permits one
73 # to use revisions such as 'HEAD' for --start or --end
74 foreach ($start, $end) {
75     next unless $_;
76     $_ = `git rev-parse $_`;
77     die unless defined $_;
78     chomp;
79 }
80
81 my $modified = () = `git ls-files --modified --deleted --others`;
82
83 die "This checkout is not clean - $modified modified or untracked file(s)"
84     if $modified;
85
86 sub validate {
87     my $commit = shift;
88     if (defined $start && `git rev-list -n1 $commit ^$start^` eq "") {
89         print "Skipping $commit, as it is earlier than $start\n";
90         return;
91     }
92     if (defined $end && `git rev-list -n1 $end ^$commit^` eq "") {
93         print "Skipping $commit, as it is more recent than $end\n";
94         return;
95     }
96     print "Testing $commit...\n";
97     system "git checkout $commit </dev/null" and die;
98     my $ret = system $^X, $runner, '--no-clean', @ARGV;
99     die "Runner returned $ret, not 0 for revision $commit" if $ret;
100     system 'git clean -dxf </dev/null' and die;
101     system 'git reset --hard HEAD </dev/null' and die;
102     return $commit;
103 }
104
105 if ($validate) {
106     require Text::Wrap;
107     my @built = map {validate $_} 'blead', reverse @stable;
108     if (@built) {
109         print Text::Wrap::wrap("", "", "Successfully validated @built\n");
110         exit 0;
111     }
112     print "Did not validate anything\n";
113     exit 1;
114 }
115
116 my $git_version = `git --version`;
117 if (defined $git_version
118     && $git_version =~ /\Agit version (\d+\.\d+\.\d+)(.*)/) {
119     $git_version = eval "v$1";
120 } else {
121     $git_version = v0.0.0;
122 }
123
124 if ($git_version ge v1.6.6) {
125     system "git bisect reset HEAD" and die;
126 } else {
127     system "git bisect reset" and die;
128 }
129
130 # Sanity check the first and last revisions:
131 system "git checkout $end" and die;
132 my $ret = system $^X, $runner, @ARGV;
133 die "Runner returned $ret for end revision" unless $ret;
134
135 if (defined $start) {
136     system "git checkout $start" and die;
137     my $ret = system $^X, $runner, @ARGV;
138     die "Runner returned $ret, not 0 for start revision" if $ret;
139 } else {
140     # Try to find the earliest version for which the test works
141     my @tried;
142     foreach my $try (@stable) {
143         if (`git rev-list -n1 $end ^$try^` eq "") {
144             print "Skipping $try, as it is more recent than end commit "
145                 . (substr $end, 0, 16) . "\n";
146             # As @stable is supposed to be in age order, arguably we should
147             # last; here.
148             next;
149         }
150         system "git checkout $try" and die;
151         my $ret = system $^X, $runner, @ARGV;
152         if (!$ret) {
153             $start = $try;
154             last;
155         }
156         push @tried, $try;
157     }
158     die "Can't find a suitable start revision to default to.\nTried @tried"
159         unless defined $start;
160 }
161
162 system "git bisect start" and die;
163 system "git bisect good $start" and die;
164 system "git bisect bad $end" and die;
165
166 # And now get git bisect to do the hard work:
167 system 'git', 'bisect', 'run', $^X, $runner, @ARGV and die;
168
169 END {
170     my $end_time = time;
171
172     printf "That took %d seconds\n", $end_time - $start_time
173         if defined $start_time;
174 }
175
176 =for comment
177
178 Documentation for this is in bisect-runner.pl
179
180 =cut
181
182 # Local variables:
183 # cperl-indent-level: 4
184 # indent-tabs-mode: nil
185 # End:
186 #
187 # ex: set ts=8 sts=4 sw=4 et: