utils/RegressionFinder.pl

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