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 | |
0ed3b851 NC |
14 | my ($start, $end, $validate, $usage, $bad); |
15 | $bad = !GetOptions('start=s' => \$start, 'end=s' => \$end, | |
16 | validate => \$validate, 'usage|help|?' => \$usage); | |
17 | unshift @ARGV, '--help' if $bad || $usage; | |
b826a648 | 18 | unshift @ARGV, '--validate' if $validate; |
e2760528 | 19 | |
77ae6092 NC |
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 | ||
0ed3b851 NC |
25 | system $^X, $runner, '--check-args', '--check-shebang', @ARGV and exit 255; |
26 | exit 255 if $bad; | |
27 | exit 0 if $usage; | |
28 | ||
5842706e NC |
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 | ||
0ed3b851 | 37 | my $start_time = time; |
6a8dbfd7 | 38 | |
4819dd2a | 39 | # We try these in this order for the start revision if none is specified. |
3ffe2687 NC |
40 | my @stable = qw(perl-5.005 perl-5.6.0 perl-5.8.0 v5.10.0 v5.12.0 v5.14.0); |
41 | ||
42 | { | |
43 | my ($dev_C, $ino_C) = stat 'Configure'; | |
44 | my ($dev_c, $ino_c) = stat 'configure'; | |
45 | if (defined $dev_C && defined $dev_c | |
46 | && $dev_C == $dev_c && $ino_C == $ino_c) { | |
eef6290d | 47 | print "You seem to be on a case-insensitive file system.\n\n"; |
3ffe2687 NC |
48 | } else { |
49 | unshift @stable, qw(perl-5.002 perl-5.003 perl-5.004) | |
50 | } | |
51 | } | |
e295b7be | 52 | |
6a8dbfd7 | 53 | $end = 'blead' unless defined $end; |
c382b335 NC |
54 | |
55 | # Canonicalising branches to revisions before moving the checkout permits one | |
56 | # to use revisions such as 'HEAD' for --start or --end | |
57 | foreach ($start, $end) { | |
58 | next unless $_; | |
59 | $_ = `git rev-parse $_`; | |
60 | die unless defined $_; | |
61 | chomp; | |
62 | } | |
6a8dbfd7 NC |
63 | |
64 | my $modified = () = `git ls-files --modified --deleted --others`; | |
65 | ||
66 | die "This checkout is not clean - $modified modified or untracked file(s)" | |
67 | if $modified; | |
68 | ||
195ed8b1 NC |
69 | sub validate { |
70 | my $commit = shift; | |
3f14869b NC |
71 | if (defined $start && `git rev-list -n1 $commit ^$start^` eq "") { |
72 | print "Skipping $commit, as it is earlier than $start\n"; | |
73 | return; | |
74 | } | |
75 | if (defined $end && `git rev-list -n1 $end ^$commit^` eq "") { | |
76 | print "Skipping $commit, as it is more recent than $end\n"; | |
77 | return; | |
78 | } | |
195ed8b1 NC |
79 | print "Testing $commit...\n"; |
80 | system "git checkout $commit </dev/null" and die; | |
81 | my $ret = system $^X, $runner, '--no-clean', @ARGV; | |
82 | die "Runner returned $ret, not 0 for revision $commit" if $ret; | |
83 | system 'git clean -dxf </dev/null' and die; | |
84 | system 'git reset --hard HEAD </dev/null' and die; | |
e2760528 | 85 | return $commit; |
195ed8b1 NC |
86 | } |
87 | ||
88 | if ($validate) { | |
e2760528 NC |
89 | require Text::Wrap; |
90 | my @built = map {validate $_} 'blead', reverse @stable; | |
91 | if (@built) { | |
92 | print Text::Wrap::wrap("", "", "Successfully validated @built\n"); | |
93 | exit 0; | |
94 | } | |
95 | print "Did not validate anything\n"; | |
96 | exit 1; | |
195ed8b1 NC |
97 | } |
98 | ||
c382b335 NC |
99 | my $git_version = `git --version`; |
100 | if (defined $git_version | |
101 | && $git_version =~ /\Agit version (\d+\.\d+\.\d+)(.*)/) { | |
102 | $git_version = eval "v$1"; | |
103 | } else { | |
104 | $git_version = v0.0.0; | |
105 | } | |
106 | ||
107 | if ($git_version ge v1.6.6) { | |
108 | system "git bisect reset HEAD" and die; | |
109 | } else { | |
110 | system "git bisect reset" and die; | |
111 | } | |
6a8dbfd7 | 112 | |
6a8dbfd7 | 113 | # Sanity check the first and last revisions: |
c382b335 NC |
114 | system "git checkout $end" and die; |
115 | my $ret = system $^X, $runner, @ARGV; | |
116 | die "Runner returned $ret for end revision" unless $ret; | |
117 | ||
4819dd2a NC |
118 | if (defined $start) { |
119 | system "git checkout $start" and die; | |
e295b7be | 120 | my $ret = system $^X, $runner, @ARGV; |
4819dd2a NC |
121 | die "Runner returned $ret, not 0 for start revision" if $ret; |
122 | } else { | |
123 | # Try to find the earliest version for which the test works | |
03cc0342 | 124 | my @tried; |
4819dd2a | 125 | foreach my $try (@stable) { |
03cc0342 NC |
126 | if (`git rev-list -n1 $end ^$try^` eq "") { |
127 | print "Skipping $try, as it is more recent than end commit " | |
128 | . (substr $end, 0, 16) . "\n"; | |
129 | # As @stable is supposed to be in age order, arguably we should | |
130 | # last; here. | |
131 | next; | |
132 | } | |
4819dd2a | 133 | system "git checkout $try" and die; |
e295b7be | 134 | my $ret = system $^X, $runner, @ARGV; |
4819dd2a NC |
135 | if (!$ret) { |
136 | $start = $try; | |
137 | last; | |
138 | } | |
03cc0342 | 139 | push @tried, $try; |
4819dd2a | 140 | } |
03cc0342 | 141 | die "Can't find a suitable start revision to default to.\nTried @tried" |
4819dd2a NC |
142 | unless defined $start; |
143 | } | |
6a8dbfd7 NC |
144 | |
145 | system "git bisect start" and die; | |
146 | system "git bisect good $start" and die; | |
147 | system "git bisect bad $end" and die; | |
148 | ||
149 | # And now get git bisect to do the hard work: | |
e295b7be | 150 | system 'git', 'bisect', 'run', $^X, $runner, @ARGV and die; |
6a8dbfd7 | 151 | |
c3d98a71 NC |
152 | END { |
153 | my $end_time = time; | |
6a8dbfd7 | 154 | |
c3d98a71 NC |
155 | printf "That took %d seconds\n", $end_time - $start_time |
156 | if defined $start_time; | |
157 | } | |
158 | ||
9b404864 NC |
159 | =for comment |
160 | ||
161 | Documentation for this is in bisect-runner.pl | |
162 | ||
163 | =cut | |
164 | ||
c3d98a71 NC |
165 | # Local variables: |
166 | # cperl-indent-level: 4 | |
167 | # indent-tabs-mode: nil | |
168 | # End: | |
169 | # | |
170 | # ex: set ts=8 sts=4 sw=4 et: |