Commit | Line | Data |
---|---|---|
6a8dbfd7 NC |
1 | #!/usr/bin/perl -w |
2 | use strict; | |
3 | ||
9b404864 NC |
4 | =for comment |
5 | ||
6 | Documentation for this is in bisect-runner.pl | |
7 | ||
8 | =cut | |
9 | ||
e295b7be NC |
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); | |
6a8dbfd7 | 13 | |
02b83d1d | 14 | my ($start, $end, $validate, $usage, $bad, $jobs, $make, $gold); |
d3232d34 | 15 | $bad = !GetOptions('start=s' => \$start, 'end=s' => \$end, |
02b83d1d | 16 | 'jobs|j=i' => \$jobs, 'make=s' => \$make, 'gold=s' => \$gold, |
0ed3b851 NC |
17 | validate => \$validate, 'usage|help|?' => \$usage); |
18 | unshift @ARGV, '--help' if $bad || $usage; | |
b826a648 | 19 | unshift @ARGV, '--validate' if $validate; |
e2760528 | 20 | |
77ae6092 NC |
21 | my $runner = $0; |
22 | $runner =~ s/bisect\.pl/bisect-runner.pl/; | |
23 | ||
24 | die "Can't find bisect runner $runner" unless -f $runner; | |
25 | ||
0ed3b851 NC |
26 | system $^X, $runner, '--check-args', '--check-shebang', @ARGV and exit 255; |
27 | exit 255 if $bad; | |
28 | exit 0 if $usage; | |
29 | ||
0ed3b851 | 30 | my $start_time = time; |
6a8dbfd7 | 31 | |
d3232d34 NC |
32 | if (!defined $jobs && |
33 | !($^O eq 'hpux' && system((defined $make ? $make : 'make') | |
34 | . ' --version >/dev/null 2>&1'))) { | |
0bc550ba NC |
35 | # Try to default to (ab)use all the CPUs: |
36 | my $cpus; | |
37 | if (open my $fh, '<', '/proc/cpuinfo') { | |
38 | while (<$fh>) { | |
39 | ++$cpus if /^processor\s+:\s+\d+$/; | |
40 | } | |
41 | } elsif (-x '/sbin/sysctl') { | |
42 | $cpus = $1 if `/sbin/sysctl hw.ncpu` =~ /^hw\.ncpu: (\d+)$/; | |
43 | } elsif (-x '/usr/bin/getconf') { | |
44 | $cpus = $1 if `/usr/bin/getconf _NPROCESSORS_ONLN` =~ /^(\d+)$/; | |
45 | } | |
46 | $jobs = defined $cpus ? $cpus + 1 : 2; | |
47 | } | |
48 | ||
d3232d34 NC |
49 | unshift @ARGV, '--jobs', $jobs if defined $jobs; |
50 | unshift @ARGV, '--make', $make if defined $make; | |
0bc550ba | 51 | |
4819dd2a | 52 | # We try these in this order for the start revision if none is specified. |
f66c64b1 NC |
53 | my @stable = map {chomp $_; $_} grep {/v5\.[0-9]+[02468]\.0$/} `git tag -l`; |
54 | die "git tag -l didn't seem to return any tags for stable releases" | |
55 | unless @stable; | |
56 | unshift @stable, qw(perl-5.005 perl-5.6.0 perl-5.8.0); | |
3ffe2687 NC |
57 | |
58 | { | |
59 | my ($dev_C, $ino_C) = stat 'Configure'; | |
60 | my ($dev_c, $ino_c) = stat 'configure'; | |
61 | if (defined $dev_C && defined $dev_c | |
62 | && $dev_C == $dev_c && $ino_C == $ino_c) { | |
eef6290d | 63 | print "You seem to be on a case-insensitive file system.\n\n"; |
3ffe2687 NC |
64 | } else { |
65 | unshift @stable, qw(perl-5.002 perl-5.003 perl-5.004) | |
66 | } | |
67 | } | |
e295b7be | 68 | |
02b83d1d NC |
69 | unshift @ARGV, '--gold', defined $gold ? $gold : $stable[-1]; |
70 | ||
7f39e2df NC |
71 | if (!defined $end) { |
72 | # If we have a branch blead, use that as the end | |
73 | $end = `git rev-parse --verify --quiet blead`; | |
74 | die unless defined $end; | |
75 | if (!length $end) { | |
76 | # Else use whichever is newer - HEAD, or the most recent stable tag. | |
77 | if (`git rev-list -n1 HEAD ^$stable[-1]` eq "") { | |
78 | $end = pop @stable; | |
79 | } else { | |
80 | $end = 'HEAD'; | |
81 | } | |
82 | } | |
83 | } | |
c382b335 NC |
84 | |
85 | # Canonicalising branches to revisions before moving the checkout permits one | |
86 | # to use revisions such as 'HEAD' for --start or --end | |
87 | foreach ($start, $end) { | |
88 | next unless $_; | |
89 | $_ = `git rev-parse $_`; | |
90 | die unless defined $_; | |
91 | chomp; | |
92 | } | |
6a8dbfd7 | 93 | |
c8fde7fa NC |
94 | { |
95 | my $modified = my @modified = `git ls-files --modified --deleted --others`; | |
6a8dbfd7 | 96 | |
c8fde7fa NC |
97 | my ($dev0, $ino0) = stat $0; |
98 | die "Can't stat $0: $!" unless defined $ino0; | |
99 | my ($dev1, $ino1) = stat 'Porting/bisect.pl'; | |
100 | ||
101 | my $inplace = defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1; | |
102 | ||
103 | if ($modified) { | |
104 | my $final = $inplace | |
105 | ? "Can't run a bisect using a dirty directory containing $runner" | |
106 | : "You can use 'git clean -Xdf' to cleanup the ignored files"; | |
107 | ||
108 | die "This checkout is not clean, found file(s):\n", | |
109 | join("\t","",@modified), | |
110 | "$modified modified, untracked, or other file(s)\n", | |
111 | "These files may not show in git status as they may be ignored.\n", | |
112 | "$final.\n"; | |
113 | } | |
114 | ||
115 | if ($inplace) { | |
116 | # We assume that it's safe to copy the runner to the temporary | |
117 | # directory and run it from there, because a shared /tmp should be +t | |
118 | # and hence others are not be able to delete or rename our file. | |
119 | require File::Temp; | |
120 | my ($to, $toname) = File::Temp::tempfile(); | |
121 | die "Can't create tempfile" | |
122 | unless $to; | |
123 | open my $from, '<', $runner | |
124 | or die "Can't open '$runner': $!"; | |
125 | local $/; | |
126 | print {$to} <$from> | |
127 | or die "Can't copy from '$runner' to '$toname': $!"; | |
128 | close $from | |
129 | or die "Can't close '$runner': $!"; | |
130 | close $to | |
131 | or die "Can't close '$toname': $!"; | |
132 | chmod 0500, $toname | |
133 | or die "Can't chmod 0500, '$toname': $!"; | |
134 | $runner = $toname; | |
135 | system $^X, $runner, '--check-args', @ARGV | |
136 | and die "Can't run inplace for some reason. :-("; | |
137 | } | |
138 | } | |
6a8dbfd7 | 139 | |
195ed8b1 NC |
140 | sub validate { |
141 | my $commit = shift; | |
3f14869b NC |
142 | if (defined $start && `git rev-list -n1 $commit ^$start^` eq "") { |
143 | print "Skipping $commit, as it is earlier than $start\n"; | |
144 | return; | |
145 | } | |
146 | if (defined $end && `git rev-list -n1 $end ^$commit^` eq "") { | |
147 | print "Skipping $commit, as it is more recent than $end\n"; | |
148 | return; | |
149 | } | |
195ed8b1 NC |
150 | print "Testing $commit...\n"; |
151 | system "git checkout $commit </dev/null" and die; | |
152 | my $ret = system $^X, $runner, '--no-clean', @ARGV; | |
153 | die "Runner returned $ret, not 0 for revision $commit" if $ret; | |
154 | system 'git clean -dxf </dev/null' and die; | |
155 | system 'git reset --hard HEAD </dev/null' and die; | |
e2760528 | 156 | return $commit; |
195ed8b1 NC |
157 | } |
158 | ||
159 | if ($validate) { | |
e2760528 NC |
160 | require Text::Wrap; |
161 | my @built = map {validate $_} 'blead', reverse @stable; | |
162 | if (@built) { | |
163 | print Text::Wrap::wrap("", "", "Successfully validated @built\n"); | |
164 | exit 0; | |
165 | } | |
166 | print "Did not validate anything\n"; | |
167 | exit 1; | |
195ed8b1 NC |
168 | } |
169 | ||
c382b335 NC |
170 | my $git_version = `git --version`; |
171 | if (defined $git_version | |
172 | && $git_version =~ /\Agit version (\d+\.\d+\.\d+)(.*)/) { | |
173 | $git_version = eval "v$1"; | |
174 | } else { | |
175 | $git_version = v0.0.0; | |
176 | } | |
177 | ||
178 | if ($git_version ge v1.6.6) { | |
179 | system "git bisect reset HEAD" and die; | |
180 | } else { | |
181 | system "git bisect reset" and die; | |
182 | } | |
6a8dbfd7 | 183 | |
6a8dbfd7 | 184 | # Sanity check the first and last revisions: |
c382b335 NC |
185 | system "git checkout $end" and die; |
186 | my $ret = system $^X, $runner, @ARGV; | |
187 | die "Runner returned $ret for end revision" unless $ret; | |
a84ce349 NC |
188 | die "Runner returned $ret for end revision, which is a skip" |
189 | if $ret == 125 * 256; | |
c382b335 | 190 | |
4819dd2a NC |
191 | if (defined $start) { |
192 | system "git checkout $start" and die; | |
e295b7be | 193 | my $ret = system $^X, $runner, @ARGV; |
4819dd2a NC |
194 | die "Runner returned $ret, not 0 for start revision" if $ret; |
195 | } else { | |
196 | # Try to find the earliest version for which the test works | |
03cc0342 | 197 | my @tried; |
4819dd2a | 198 | foreach my $try (@stable) { |
03cc0342 NC |
199 | if (`git rev-list -n1 $end ^$try^` eq "") { |
200 | print "Skipping $try, as it is more recent than end commit " | |
201 | . (substr $end, 0, 16) . "\n"; | |
202 | # As @stable is supposed to be in age order, arguably we should | |
203 | # last; here. | |
204 | next; | |
205 | } | |
4819dd2a | 206 | system "git checkout $try" and die; |
e295b7be | 207 | my $ret = system $^X, $runner, @ARGV; |
4819dd2a NC |
208 | if (!$ret) { |
209 | $start = $try; | |
210 | last; | |
211 | } | |
03cc0342 | 212 | push @tried, $try; |
4819dd2a | 213 | } |
03cc0342 | 214 | die "Can't find a suitable start revision to default to.\nTried @tried" |
4819dd2a NC |
215 | unless defined $start; |
216 | } | |
6a8dbfd7 NC |
217 | |
218 | system "git bisect start" and die; | |
219 | system "git bisect good $start" and die; | |
220 | system "git bisect bad $end" and die; | |
221 | ||
222 | # And now get git bisect to do the hard work: | |
e295b7be | 223 | system 'git', 'bisect', 'run', $^X, $runner, @ARGV and die; |
6a8dbfd7 | 224 | |
c3d98a71 NC |
225 | END { |
226 | my $end_time = time; | |
6a8dbfd7 | 227 | |
625770c2 | 228 | printf "That took %d seconds.\n", $end_time - $start_time |
c3d98a71 NC |
229 | if defined $start_time; |
230 | } | |
231 | ||
9b404864 NC |
232 | =for comment |
233 | ||
234 | Documentation for this is in bisect-runner.pl | |
235 | ||
236 | =cut | |
237 | ||
c3d98a71 | 238 | # ex: set ts=8 sts=4 sw=4 et: |