diff --git a/utils/RegressionFinder.pl b/utils/RegressionFinder.pl new file mode 100755 index 00000000000..94c8c736771 --- /dev/null +++ b/utils/RegressionFinder.pl @@ -0,0 +1,185 @@ +#! /usr/dcs/software/supported/bin/perl +# Script to find regressions by binary-searching a time interval in the CVS tree. +# Written by Brian Gaeke on 2-Mar-2004 +# + +use Getopt::Std; +use POSIX; +use Time::Local; +use IO::Handle; + +sub usage { + print STDERR <) { + if (/$regex/) { + close FILE; + return 1; + } + } + close FILE; + return 0; +} + +sub updateSources { + my ($time) = @_; + my $inst = "include/llvm/Instruction.h"; + unlink($inst); + run( "cvs update -D'" . timeAsString($time) . "'" ); + if ( !contains( $inst, 'class Instruction.*Annotable' ) ) { + run("patch -F100 -p0 < makeInstructionAnnotable.patch"); + } +} + +sub regressionPresentAt { + my ($time) = @_; + + updateSources($time); + buildLibrariesAndTools(); + my $rc = run($SCRIPT); + if ($rc) { + print LOG "** Found that regression was PRESENT at " + . timeAsString($time) . "\n"; + return 1; + } + else { + print LOG "** Found that regression was ABSENT at " + . timeAsString($time) . "\n"; + return 0; + } +} + +sub regressionAbsentAt { + my ($time) = @_; + return !regressionPresentAt($time); +} + +sub closeTo { + my ( $time1, $time2 ) = @_; + return abs( $time1 - $time2 ) < 600; # 10 minutes seems reasonable. +} + +sub halfWayPoint { + my ( $time1, $time2 ) = @_; + my $halfSpan = int( abs( $time1 - $time2 ) / 2 ); + if ( $time1 < $time2 ) { + return $time1 + $halfSpan; + } + else { + return $time2 + $halfSpan; + } +} + +sub checkBoundaryConditions { + print LOG "** Checking for presence of regression at ", timeAsString($DTIME), + "\n"; + if ( !regressionPresentAt($DTIME) ) { + die ( "** Can't help you; $SCRIPT says regression absent at dtime: " + . timeAsString($DTIME) + . "\n" ); + } + print LOG "** Checking for absence of regression at ", timeAsString($WTIME), + "\n"; + if ( !regressionAbsentAt($WTIME) ) { + die ( "** Can't help you; $SCRIPT says regression present at wtime: " + . timeAsString($WTIME) + . "\n" ); + } +} + +############################################################################## + +# Set up log files +open (STDERR, ">&STDOUT") || die "** Can't redirect std.err: $!\n"; +autoflush STDOUT 1; +autoflush STDERR 1; +open (LOG, ">RegFinder.log") || die "** can't write RegFinder.log: $!\n"; +autoflush LOG 1; +# Check command line arguments and environment variables +getopts('Iw:d:t:c:'); +if ( !( $opt_w && $opt_d && $opt_t && $opt_c ) ) { + usage; +} +$MAKE = $ENV{'MAKE'}; +$MAKE = 'gmake' unless $MAKE; +$WTIME = timeAsSeconds($opt_w); +print LOG "** Assuming worked at ", timeAsString($WTIME), "\n"; +$DTIME = timeAsSeconds($opt_d); +print LOG "** Assuming didn't work at ", timeAsString($DTIME), "\n"; +$opt_t =~ s/\s*//g; +$SCRIPT = $opt_c; +die "** $SCRIPT is not executable or not found\n" unless -x $SCRIPT; +print LOG "** Checking for the regression using $SCRIPT\n"; +@TOOLS = split ( /,/, $opt_t ); +print LOG ( + "** Going to rebuild: ", + ( join ", ", @TOOLS ), + " before each $SCRIPT run\n" +); +if ($opt_I) { checkBoundaryConditions(); } +# do the dirty work: +while ( !closeTo( $DTIME, $WTIME ) ) { + my $halfPt = halfWayPoint( $DTIME, $WTIME ); + print LOG "** Checking whether regression is present at ", + timeAsString($halfPt), "\n"; + if ( regressionPresentAt($halfPt) ) { + $DTIME = $halfPt; + } + else { + $WTIME = $halfPt; + } +} +# Tell them what we found +print LOG "** Narrowed it down to:\n"; +print LOG "** Worked at: ", timeAsString($WTIME), "\n"; +print LOG "** Did not work at: ", timeAsString($DTIME), "\n"; +close LOG; +exit 0;