aboutsummaryrefslogtreecommitdiff
path: root/bisect/bisect.pl
blob: acf6c213c88ae5c5fef7f39bc7e44c6e4d7191e8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
#!/usr/bin/env perl

# This script drives the bisection of LLVM/Clang/RT regressions
# by receiving checkout, build and test commands.
#
# By default, the lines are:
#   checkout: './checkout.sh'
#      build: './run.sh'
#       test: ''
#
# Which means: success == builds.
#
# If you use a different checkout script, make sure it accepts one
# parameter, the SVN revision.
#
# Since testing is the hard part, you should write your own
# custom test script for each job, but you can reuse the checkout
# and run scripts if you like.
#
# The test script should return 0 when the commit is GOOD and non-zero
# when it is bad.
#
# The build script has a way to quickly test (check-all, test-suite)
# and you can use that as well, as a shortcut for the testing.

use strict;
use warnings;
use Getopt::Std;
use Scalar::Util qw(looks_like_number);

################################## Command line parsing and validation
my ($prog) = ($0 =~ /\/([^\/]+)$/);
my $syntax = "Syntax: $prog [-c checkout_script] [-b build_script] [-t test_script] good_rev bad_rev\n";
die $syntax unless &getopts('c:b:t:');
our($opt_c, $opt_b, $opt_t);
# Job Statuses
my $Good = 0;
my $CompilerError = 1;
my $TestError = 2;
# Defaults
my ($checkout, $build, $test) = ("./checkout.sh", "./run.sh", "");
$checkout = $opt_c if defined $opt_c;
$build = $opt_b if defined $opt_b;
$test = $opt_t if defined $opt_t;
# Validate
die "Invalid checkout script '$checkout'\n" unless &validate_script(\$checkout);
die "Invalid run script '$build'\n" unless &validate_script(\$build);
die "Invalid test script '$test'\n" unless not $test or &validate_script(\$test);
# Revs
my $last = scalar @ARGV-1;
die $syntax unless $last == 1;
my $good_rev = $ARGV[$last-1];
die $syntax unless looks_like_number $good_rev;
my $bad_rev = $ARGV[$last];
die $syntax unless looks_like_number $bad_rev;
die "Bad rev '$bad_rev' is less than or equal good rev '$good_rev'\n"
  unless $bad_rev > $good_rev;
&main();
exit;

################################## Main bisect logic

sub main () {
  my ($good, $bad) = ($good_rev, $bad_rev);

  # Header
  print "\n==============================================\n".
        " Checkout script: $checkout\n".
        "    Build script: $build\n".
        "     Test script: $test\n".
        " Range: [ $good, $bad ]\n".
        "\n==============================================\n";

  # Iterations
  my $step = 1;
  my $range = $bad-$good;
  my $forced_rev = 0;
  while ($bad > $good and $bad != $good+1) {
    my $rev = int($good+($bad-$good)/2);
    # Use forced rev, from compilation error
    if ($forced_rev) {
      $rev = $forced_rev;
      $forced_rev = 0;
    }
    print "\n---------------------------\n";
    print "Step $step: $good -> $rev -> $bad\n";
    my $result = &check($rev);
    # All good
    if ($result == $Good) {
      print "Revision '$rev' is good\n";
      rename "$rev.log", "$rev.good";
      $good = $rev;
    # Compiler error when test should run
    } elsif ($result == $CompilerError and $test) {
      print "Revision '$rev' has a compiler error\n".
            "Since you're looking for a test error,\n".
            "we'll skip a rev\n";
      rename "$rev.log", "$rev.compile";
      $forced_rev = $rev+1;
    # Proper error
    } else {
      print "Revision '$rev' is bad\n";
      rename "$rev.log", "$rev.bad";
      $bad = $rev;
    }
    $step++;
  }

  # Final status
  print "\n==============================================\n".
        " First bad revision is '$bad'\n".
        " Found in $step steps in a range of $range commits".
        "\n==============================================\n";
}

################################## Checkout, run, test

sub check ($) {
  my ($rev) = @_;
  unlink "$rev.log";
  my $log = "2>&1 >> $rev.log";
  print "Checking out rev '$rev'\n";
  die "Error while checking out '$rev'\n" if system("$checkout $rev $log");
  print "Building rev '$rev'\n";
  return $CompilerError if system("$build $log");
  if ($test) {
    print "Testing rev '$rev'\n";
    return $TestError if system("$test $log");
  }
  return $Good;
}

################################## Helpers

sub validate_script($) {
  my ($command) = @_;
  my ($script) = split /\s+/, $$command;
  return 0 if (! -x $script);
  if ($script !~ /^[\/\.]/) {
    $script = "./$script";
    return 0 if (! -x $script);
    $$command = "./$$command";
  }
  return 1;
}