This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
mktables: Improve \p{xids} defn for early Unicodes
[perl5.git] / Porting / bisect.pl
CommitLineData
6a8dbfd7
NC
1#!/usr/bin/perl -w
2use strict;
3
9b404864
NC
4=for comment
5
6Documentation 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.
12use Getopt::Long qw(:config pass_through no_auto_abbrev);
6a8dbfd7 13
0ed3b851
NC
14my ($start, $end, $validate, $usage, $bad);
15$bad = !GetOptions('start=s' => \$start, 'end=s' => \$end,
16 validate => \$validate, 'usage|help|?' => \$usage);
17unshift @ARGV, '--help' if $bad || $usage;
b826a648 18unshift @ARGV, '--validate' if $validate;
e2760528 19
77ae6092
NC
20my $runner = $0;
21$runner =~ s/bisect\.pl/bisect-runner.pl/;
22
23die "Can't find bisect runner $runner" unless -f $runner;
24
0ed3b851
NC
25system $^X, $runner, '--check-args', '--check-shebang', @ARGV and exit 255;
26exit 255 if $bad;
27exit 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 37my $start_time = time;
6a8dbfd7 38
4819dd2a 39# We try these in this order for the start revision if none is specified.
3ffe2687
NC
40my @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
57foreach ($start, $end) {
58 next unless $_;
59 $_ = `git rev-parse $_`;
60 die unless defined $_;
61 chomp;
62}
6a8dbfd7
NC
63
64my $modified = () = `git ls-files --modified --deleted --others`;
65
66die "This checkout is not clean - $modified modified or untracked file(s)"
67 if $modified;
68
195ed8b1
NC
69sub 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
88if ($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
99my $git_version = `git --version`;
100if (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
107if ($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
114system "git checkout $end" and die;
115my $ret = system $^X, $runner, @ARGV;
116die "Runner returned $ret for end revision" unless $ret;
117
4819dd2a
NC
118if (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
145system "git bisect start" and die;
146system "git bisect good $start" and die;
147system "git bisect bad $end" and die;
148
149# And now get git bisect to do the hard work:
e295b7be 150system 'git', 'bisect', 'run', $^X, $runner, @ARGV and die;
6a8dbfd7 151
c3d98a71
NC
152END {
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
161Documentation 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: