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