utils/RegressionFinder.pl

   1 #! /usr/bin/perl
   2 # Script to find regressions by binary-searching a time interval in the
   3 # CVS tree.  Written by Brian Gaeke on 2-Mar-2004.
   4 #
   5
   6 require 5.6.0;  # NOTE: This script not tested with earlier versions.
   7 use Getopt::Std;
   8 use POSIX;
   9 use Time::Local;
  10 use IO::Handle;
  11
  12 sub usage {
  13     print STDERR <<END;
  14 findRegression [-I] -w WTIME -d DTIME -t TOOLS -c SCRIPT
  15
  16 The -w, -d, -t, and -c options are required.
  17 Run findRegression in the top level of an LLVM tree.
  18 WTIME is a time when you are sure the regression does NOT exist ("Works").
  19 DTIME is a time when you are sure the regression DOES exist ("Doesntwork").
  20 WTIME and DTIME are both in the format: "YYYY/MM/DD HH:MM".
  21 -I means run builds at WTIME and DTIME first to make sure.
  22 TOOLS is a comma separated list of tools to rebuild before running SCRIPT.
  23 SCRIPT exits 1 if the regression is present in TOOLS; 0 otherwise.
  24 END
  25     exit 1;
  26 }
  27
  28 sub timeAsSeconds {
  29     my ($timestr) = @_;
  30
  31     if ( $timestr =~ /(\d\d\d\d)\/(\d\d)\/(\d\d) (\d\d):(\d\d)/ ) {
  32         my ( $year, $mon, $mday, $hour, $min ) = ( $1, $2, $3, $4, $5 );
  33         return timegm( 0, $min, $hour, $mday, $mon - 1, $year );
  34     }
  35     else {
  36         die "** Can't parse date + time: $timestr\n";
  37     }
  38 }
  39
  40 sub timeAsString {
  41     my ($secs) = @_;
  42     return strftime( "%Y/%m/%d %H:%M", gmtime($secs) );
  43 }
  44
  45 sub run {
  46     my ($cmdline) = @_;
  47     print LOG "** Running: $cmdline\n";
  48         return system($cmdline);
  49 }
  50
  51 sub buildLibrariesAndTools {
  52     run("sh /home/vadve/gaeke/scripts/run-configure");
  53     run("$MAKE -C lib/Support");
  54     run("$MAKE -C utils");
  55     run("$MAKE -C lib");
  56     foreach my $tool (@TOOLS) { run("$MAKE -C tools/$tool"); }
  57 }
  58
  59 sub contains {
  60     my ( $file, $regex ) = @_;
  61     local (*FILE);
  62     open( FILE, "<$file" ) or die "** can't read $file: $!\n";
  63     while (<FILE>) {
  64         if (/$regex/) {
  65             close FILE;
  66             return 1;
  67         }
  68     }
  69     close FILE;
  70     return 0;
  71 }
  72
  73 sub updateSources {
  74     my ($time) = @_;
  75     my $inst = "include/llvm/Instruction.h";
  76     unlink($inst);
  77     run( "cvs update -D'" . timeAsString($time) . "'" );
  78     if ( !contains( $inst, 'class Instruction.*Annotable' ) ) {
  79         run("patch -F100 -p0 < makeInstructionAnnotable.patch");
  80     }
  81 }
  82
  83 sub regressionPresentAt {
  84     my ($time) = @_;
  85
  86     updateSources($time);
  87     buildLibrariesAndTools();
  88     my $rc = run($SCRIPT);
  89     if ($rc) {
  90         print LOG "** Found that regression was PRESENT at "
  91           . timeAsString($time) . "\n";
  92         return 1;
  93     }
  94     else {
  95         print LOG "** Found that regression was ABSENT at "
  96           . timeAsString($time) . "\n";
  97         return 0;
  98     }
  99 }
 100
 101 sub regressionAbsentAt {
 102     my ($time) = @_;
 103     return !regressionPresentAt($time);
 104 }
 105
 106 sub closeTo {
 107     my ( $time1, $time2 ) = @_;
 108     return abs( $time1 - $time2 ) < 600;    # 10 minutes seems reasonable.
 109 }
 110
 111 sub halfWayPoint {
 112     my ( $time1, $time2 ) = @_;
 113     my $halfSpan = int( abs( $time1 - $time2 ) / 2 );
 114     if ( $time1 < $time2 ) {
 115         return $time1 + $halfSpan;
 116     }
 117     else {
 118         return $time2 + $halfSpan;
 119     }
 120 }
 121
 122 sub checkBoundaryConditions {
 123     print LOG "** Checking for presence of regression at ", timeAsString($DTIME),
 124       "\n";
 125     if ( !regressionPresentAt($DTIME) ) {
 126         die ( "** Can't help you; $SCRIPT says regression absent at dtime: "
 127               . timeAsString($DTIME)
 128               . "\n" );
 129     }
 130     print LOG "** Checking for absence of regression at ", timeAsString($WTIME),
 131       "\n";
 132     if ( !regressionAbsentAt($WTIME) ) {
 133         die ( "** Can't help you; $SCRIPT says regression present at wtime: "
 134               . timeAsString($WTIME)
 135               . "\n" );
 136     }
 137 }
 138
 139 ##############################################################################
 140
 141 # Set up log files
 142 open (STDERR, ">&STDOUT") || die "** Can't redirect std.err: $!\n";
 143 autoflush STDOUT 1;
 144 autoflush STDERR 1;
 145 open (LOG, ">RegFinder.log") || die "** can't write RegFinder.log: $!\n";
 146 autoflush LOG 1;
 147 # Check command line arguments and environment variables
 148 getopts('Iw:d:t:c:');
 149 if ( !( $opt_w && $opt_d && $opt_t && $opt_c ) ) {
 150     usage;
 151 }
 152 $MAKE  = $ENV{'MAKE'};
 153 $MAKE  = 'gmake' unless $MAKE;
 154 $WTIME = timeAsSeconds($opt_w);
 155 print LOG "** Assuming worked at ", timeAsString($WTIME), "\n";
 156 $DTIME = timeAsSeconds($opt_d);
 157 print LOG "** Assuming didn't work at ", timeAsString($DTIME), "\n";
 158 $opt_t =~ s/\s*//g;
 159 $SCRIPT = $opt_c;
 160 die "** $SCRIPT is not executable or not found\n" unless -x $SCRIPT;
 161 print LOG "** Checking for the regression using $SCRIPT\n";
 162 @TOOLS = split ( /,/, $opt_t );
 163 print LOG (
 164     "** Going to rebuild: ",
 165     ( join ", ", @TOOLS ),
 166     " before each $SCRIPT run\n"
 167 );
 168 if ($opt_I) { checkBoundaryConditions(); }
 169 # do the dirty work:
 170 while ( !closeTo( $DTIME, $WTIME ) ) {
 171     my $halfPt = halfWayPoint( $DTIME, $WTIME );
 172     print LOG "** Checking whether regression is present at ",
 173       timeAsString($halfPt), "\n";
 174     if ( regressionPresentAt($halfPt) ) {
 175         $DTIME = $halfPt;
 176     }
 177     else {
 178         $WTIME = $halfPt;
 179     }
 180 }
 181 # Tell them what we found
 182 print LOG "** Narrowed it down to:\n";
 183 print LOG "** Worked at: ",       timeAsString($WTIME), "\n";
 184 print LOG "** Did not work at: ", timeAsString($DTIME), "\n";
 185 close LOG;
 186 exit 0;