* first complete working version

tests/utils/dbdigest.pp

@@ -23,34 +23,48 @@
 program dbdigest;
 
 uses
+  {$ifdef unix}
+  cthreads,
+  {$endif}
   types, classes, custapp, sysutils, inifiles, teststr, testu, tresults, dbtests, digestanalyst;
 
 Type
 
+  { TThreadTask }
+
+  TThreadTask = Class(TObject)
+    CfgFileName : string;
+    Config: TDigestConfig;
+    Data: TTestRunData;
+    Constructor Create(const aFileName : String; const aConfig : TDigestConfig; aData : TTestRunData);
+  end;
+
   { TDBDigestApplication }
 
   TDBDigestApplication = class(TCustomApplication)
   Const
      ShortOpts =
-      'd'+ {  coDatabaseName }
-      'h'+ {  coHost }
-      'u'+ {  coUserName }
-      'p'+ {  coPassword }
-      'P'+ {  coPort }
-      'l'+ {  coLogFile }
-      'L'+ {  coLongLogFile }
-      'o'+ {  coOS }
-      'c'+ {  coCPU }
-      'a'+ {  coCategory }
-      'v'+ {  coVersion }
-      't'+ {  coDate }
-      's'+ {  coSubmitter }
-      'm'+ {  coMachine }
-      'C'+ {  coComment }
-      'S'+ {  coTestSrcDir }
-      'r'+ {  coRelSrcDir }
-      'V'+ {  coVerbose }
-      'Q'  {  coSQL }
+      'd'+ {  DatabaseName }
+      'h'+ {  Host }
+      'u'+ {  UserName }
+      'p'+ {  Password }
+      'P'+ {  Port }
+      'l'+ {  LogFile }
+      'L'+ {  LongLogFile }
+      'o'+ {  OS }
+      'c'+ {  CPU }
+      'a'+ {  Category }
+      'v'+ {  Version }
+      't'+ {  Date }
+      's'+ {  Submitter }
+      'm'+ {  Machine }
+      'C'+ {  Comment }
+      'S'+ {  TestSrcDir }
+      'r'+ {  RelSrcDir }
+      'T'+ {  ThreadList }
+      'j'+ {  ThreadCount }
+      'V'+ {  Verbose }
+      'Q'  {  SQL }
      ;
 
     LongOpts : Array of string = (
@@ -71,6 +85,8 @@ Type
       'comment',
       'testsrcdir',
       'relsrcdir',
+      'threadlist',
+      'threadcount',
       'verbose',
       'sql',
       'compilerdate',
@@ -80,39 +96,129 @@ Type
       'svnrtlrevision',
       'svnpackagesrevision'
     );
-    // Return true if we can continue
-    function ProcessCommandLine(var aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+
   private
+    FTasks : TThreadList;
+    FMaxThreads : Integer;
+    FThreadCount : Integer;
+    // Process the command line. Return true if we can continue
+    function ProcessCommandLine(var aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+    // Check the names of the log files, expanding them if needed.
+    function CheckConfigFiles(lCfg: String; var lData: TTestRunData): Boolean;
+    // Extract a date.
     class function ExtractDate(aValue: string): TDateTime;
+    // Analyse a log file (i.e. one dbdigest.cfg file)
     procedure Analyze(const aConfig: TDigestConfig; const aData: TTestRunData);
+    // process a config file (dbdigest.cfg file);
     procedure ProcessConfigfile(const aFileName: String; var aConfig: TDigestConfig; var aData: TTestRunData);
+    // process a single option. Adapt aConf,aData as needed. Return false if the option was not recognized.
     function ProcessOption(const aOption: String; aValue: String; var aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+    // Read /etc/dbdigest.ini for database configuration.
     procedure ReadSystemDBConfig(var aConfig: TDigestConfig);
+    // In thread mode, create a list of tasks.
+    function CreateTaskList(const aBaseConfig: TDigestConfig; const aBaseData: TTestRunData): boolean;
+    // Callback when a task is done. Checks to see if additional threads must be started.
+    procedure TaskDone(Sender: TObject);
+    // Wait for all tasks & threads to terminate.
+    procedure WaitForThreads;
+    // Start as many threads as allowed, up to task count.
+    procedure StartThreads;
   protected
+    // Run
     procedure DoRun; override;
+    // Print usage message.
     procedure Usage(const aMsg: String);
+  Public
+    Constructor Create(aOwner : TComponent); override;
+  end;
+
+  { TProcessFileThread }
+
+  TProcessFileThread = class(TThread)
+  Private
+    FTask : TThreadTask;
+    FApp : TDBDigestApplication;
+  Public
+    Constructor Create(aApp : TDBDigestApplication; const aTask : TThreadTask; aOnTerminate : TNotifyEvent);
+    Destructor Destroy; override;
+    Procedure Execute; override;
+  end;
+
+{ TThreadTask }
+
+constructor TThreadTask.Create(const aFileName: String; const aConfig: TDigestConfig; aData: TTestRunData);
+begin
+  CfgFileName:=aFileName;
+  Config:=aConfig;
+  Data:=aData;
+end;
+
+{ TProcessFileThread }
+
+constructor TProcessFileThread.Create(aApp: TDBDigestApplication; const aTask: TThreadTask; aOnTerminate: TNotifyEvent);
+begin
+  FTask:=aTask;
+  FApp:=aApp;
+  Self.OnTerminate:=aOnTerminate;
+  Inherited create(False);
+end;
+
+destructor TProcessFileThread.Destroy;
+var
+  lPrefix : String;
+  lCfg : String;
+begin
+  try
+    lCfg:=FTask.CfgFileName;
+    lPrefix:='['+IntToStr(PtrInt(GetCurrentThreadId))+' - '+lCfg+'] ';
+    FreeAndNil(FTask);
+    Verbose(V_DEBUG,lPrefix+' task destroyed ');
+  except
+    On e : Exception do
+      Verbose(V_WARNING,lPrefix+Format('Error %s during processing of "%s": %s',[E.ClassName,lCfg,E.Message]));
+  end;
+  inherited Destroy;
+end;
+
+procedure TProcessFileThread.Execute;
+var
+  lPrefix:String;
+
+begin
+  try
+    lPrefix:='['+IntToStr(PtrInt(GetCurrentThreadId))+' - '+FTask.CfgFileName+'] ';
+    FApp.Analyze(FTask.Config,FTask.Data);
+    Writeln(IntToStr(PtrInt(GetCurrentThreadId))+'Thread done');
+  except
+    On e : Exception do
+      Verbose(V_WARNING,lPrefix+Format('Error %s during processing of "%s": %s',[E.ClassName,FTask.CfgFileName,E.Message]));
   end;
+end;
 
-class Function TDBDigestApplication.ExtractDate(aValue : string) : TDateTime;
+class function TDBDigestApplication.ExtractDate(aValue: string): TDateTime;
 
 var
   year,month,day,min,hour : word;
 
 begin
-  if Length(avalue)=12 then
+  if (Length(avalue)=12) or (Length(avalue)=8) then
     begin
       year:=StrToInt(Copy(avalue,1,4));
       month:=StrToInt(Copy(avalue,5,2));
       day:=StrToInt(Copy(aValue,7,2));
-      hour:=StrToInt(Copy(aValue,9,2));
-      min:=StrToInt(Copy(aValue,11,2));
+      if Length(avalue)=12 then
+        begin
+        hour:=StrToInt(Copy(aValue,9,2));
+        min:=StrToInt(Copy(aValue,11,2));
+        end;
       Result:=EncodeDate(year,month,day)+EncodeTime(hour,min,0,0);
     end
   else
     Verbose(V_Error,'Error in date format, use YYYYMMDDhhmm');
 end;
 
-Function TDBDigestApplication.ProcessOption(const aOption : String; aValue: String; var aConfig : TDigestConfig; var aData : TTestRunData) : Boolean;
+function TDBDigestApplication.ProcessOption(const aOption: String; aValue: String; var aConfig: TDigestConfig;
+  var aData: TTestRunData): Boolean;
 
 begin
   Result:=True;
@@ -137,6 +243,8 @@ begin
     'S','testsrcdir': aConfig.testsrcdir:=aValue;
     'r','relsrcdir': aConfig.relsrcdir:=aValue;
     'V','verbose': DoVerbose:=True;
+    'T','threadlist' : ; // treated elsewhere
+    'j','threadcount' : ; // treated elsewhere
     //  'S','sql': aConfig.sql:=aValue;
     'compilerdate': aData.CompilerDate:=aValue;
     'compilerfullversion': aData.CompilerFullVersion:=aValue;
@@ -149,7 +257,7 @@ begin
   end;
 end;
 
-Procedure TDBDigestApplication.ProcessConfigfile(const aFileName : String; var aConfig : TDigestConfig; var aData : TTestRunData);
+procedure TDBDigestApplication.ProcessConfigfile(const aFileName: String; var aConfig: TDigestConfig; var aData: TTestRunData);
 
 Var
   Cfg : TStrings;
@@ -192,7 +300,7 @@ end;
 
 { TDBDigestApplication }
 
-Procedure TDBDigestApplication.Usage(const aMsg : String);
+procedure TDBDigestApplication.Usage(const aMsg: String);
 
 begin
   if (aMsg<>'') then
@@ -208,6 +316,8 @@ begin
   Writeln('-r --relsrcdir                    relative source dir');
   Writeln('-S --testsrcdir                   test source dir');
   Writeln('-u --username=USER                database user name');
+  Writeln('-T --threadlist=FILE              file with configuration file names to imports.');
+  Writeln('-j --threadcount=N                Number of threads to use');
   Writeln('-V --verbose                      be more verbose');
   Writeln('Test run data:');
   Writeln('-l --logfile=FILE                 set log file to analyse');
@@ -229,6 +339,8 @@ begin
   Writeln('   --svnrtlrevision=REV           set revision of RTL');
   Writeln('   --svnpackagesrevision=REV      set revison of packages');
   Writeln('');
+  Writeln('If -T is specified, no test run options may be specified');
+  Writeln('');
   Writeln('The config file can contain the same options as the command-line in the form.');
   Writeln('option=value');
   Writeln('where option is the long or short version of the option');
@@ -236,6 +348,12 @@ begin
   ExitCode:=Ord(aMsg<>'');
 end;
 
+constructor TDBDigestApplication.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FTasks:=TThreadList.Create;
+end;
+
 function TDBDigestApplication.ProcessCommandLine(var aConfig: TDigestConfig; var aData : TTestRunData): Boolean;
 
   Function MakeOpts(s : string) : string;
@@ -304,6 +422,7 @@ procedure TDBDigestApplication.Analyze(const aConfig : TDigestConfig; const aDat
 var
   lSQL : TTestSQL;
   lDigest : TDBDigestAnalyzer;
+  lPrefix : string;
 
 begin
   lDigest:=Nil;
@@ -311,7 +430,12 @@ begin
     lSQL:=TTestSQL.create(databasename,host,username,password,port);
   try
     lSQL.ConnectToDatabase;
-    lDigest:=TDBDigestAnalyzer.Create(lSQL);
+    if GetCurrentThreadId<>MainThreadID then
+      lPrefix:='['+IntToStr(PtrInt(GetCurrentThreadId))+' - '+aData.logfile+']: '
+    else
+      lPrefix:='';
+    lSQL.LogPrefix:=lPrefix;
+    lDigest:=TDBDigestAnalyzer.Create(lSQL,lPrefix);
     lDigest.Analyse(aConfig,aData);
   finally
     lDigest.Free;
@@ -343,6 +467,131 @@ begin
     end;
 end;
 
+function TDBDigestApplication.CheckConfigFiles(lCfg : String; var lData : TTestRunData) : Boolean;
+
+  function CheckFile(const aDir : String; var aFile : String) : boolean;
+
+  var
+    lExpanded : string;
+
+  begin
+    if (aFile<>'') and (aFile[1]<>'/') then
+      begin
+      lExpanded:=aDir+aFile;
+      Verbose(V_Debug,Format('Expanding file from %s to %s',[aFile,lExpanded]));
+      aFile:=lExpanded;
+      end;
+    Result:=FileExists(aFile);
+    if not Result then
+       Verbose(V_Warning,Format('file does not exist: %s',[lExpanded]));
+  end;
+
+var
+  lDir : String;
+
+begin
+  lDir:=ExtractFilePath(ExpandFileName(lCfg));
+  Result:=CheckFile(lDir,lData.logfile);
+  if Result then
+    Result:=CheckFile(lDir,lData.longlogfile);
+end;
+
+
+function TDBDigestApplication.CreateTaskList(const aBaseConfig: TDigestConfig; const aBaseData: TTestRunData) : boolean;
+
+var
+  lCfg,lFileName : String;
+  L : TStrings;
+  lConfig : TDigestConfig;
+  lData : TTestRunData;
+  lList : TList;
+
+
+begin
+  Result:=False;
+  lFileName:=GetOptionValue('T','threadlist');
+  if not FileExists(lFileName) then
+    begin
+    Verbose(V_Normal,'No such file :'+lFileName);
+    Exit;
+    end;
+  L:=TStringList.Create;
+  try
+    l.LoadFromFile(lFileName);
+    Result:=True;
+    For lcfg in L do
+      begin
+      if not FileExists(lCfg) then
+        begin
+        Verbose(V_Warning,'No such file: '+lcfg);
+        Result:=False;
+        end
+      else
+        begin
+        lConfig:=aBaseConfig;
+        lData:=aBaseData;
+        lList:=FTasks.LockList;
+        ProcessConfigfile(lCfg,lConfig,lData);
+        if CheckConfigFiles(lCfg,lData) then
+          lList.Add(TThreadTask.Create(lCfg,lConfig,lData))
+        else
+          Result:=False;
+        end;
+      end;
+  finally
+    l.Free;
+  end;
+end;
+
+procedure TDBDigestApplication.TaskDone(Sender: TObject);
+begin
+  InterlockedDecrement(FThreadCount);
+  StartThreads;
+end;
+
+Procedure TDBDigestApplication.StartThreads;
+
+var
+  L : TList;
+  lTask : TThreadTask;
+
+begin
+  L:=FTasks.LockList;
+  try
+    Verbose(V_DEBUG,Format('Starting tasks. Current thread count: %d remaining tasks: %d.',[FThreadCount,l.Count]));
+    While (L.Count>0) and (FThreadCount<FMaxThreads) do
+      begin
+      lTask:=TThreadTask(L[0]);
+      L.Delete(0);
+      Verbose(V_DEBUG,'Starting task for '+lTask.CfgFileName);
+      TProcessFileThread.Create(Self,lTask,@TaskDone);
+      InterlockedIncrement(FThreadCount);
+      end;
+  finally
+    FTasks.UnlockList;
+  end;
+end;
+
+procedure TDBDigestApplication.WaitForThreads;
+
+var
+  lDone : Boolean;
+  lList : TList;
+
+begin
+  Repeat
+    CheckSynchronize;
+    Sleep(100);
+    lList:=FTasks.LockList;
+    try
+      Verbose(V_DEBUG,Format('Waiting...(Todo: %d threads: %d)',[lList.Count,FThreadCount]));
+      lDone:=(lList.Count=0) and (FThreadCount=0);
+    finally
+      FTasks.UnlockList;
+    end
+  until ldone;
+end;
+
 procedure TDBDigestApplication.DoRun;
 
 var
@@ -354,13 +603,26 @@ begin
   lConfigFile:=GetOptionValue('f','config');
   if lConfigFile='' then
     lConfigFile:='dbdigest.cfg';
-  lData:=Default(TTestRunData);
   lConfig:=Default(TDigestConfig);
   lConfig.RelSrcDir:='tests/';
   ReadSystemDBConfig(lConfig);
-  ProcessConfigFile(lConfigFile,lConfig,lData);
-  if ProcessCommandLine(lConfig,lData) then
-    Analyze(lConfig,lData);
+  if not HasOption('T','threadlist') then
+    begin
+    lData:=Default(TTestRunData);
+    ProcessConfigFile(lConfigFile,lConfig,lData);
+    if ProcessCommandLine(lConfig,lData) then
+      Analyze(lConfig,lData);
+    end
+  else
+    begin
+    FMaxThreads:=StrToIntDef(GetOptionValue('j','threadcount'),4);
+    if ProcessCommandLine(lConfig,lData) then
+      if CreateTaskList(lConfig,lData) then
+        begin
+        StartThreads;
+        WaitForThreads;
+        end;
+    end;
 end;
 
 var

tests/utils/dbtests.pp

@@ -33,59 +33,99 @@ Type
     FUser : String;
     FPassword : String;
     FPort : Word;
-
+    Flogprefix : String;
     Class Procedure FreeQueryResult (Var Res : TSQLQuery);
     Class Function  GetIntResultField (Res : TSQLQuery; Id : Integer) : Integer;
     Class Function  GetInt64ResultField (Res : TSQLQuery; Id : Integer) : Int64;
     Class Function  GetStrResultField (Res : TSQLQuery; Id : Integer) : String;
+    // Overload adds prefix
+    procedure Verbose(aLevel : TVerboseLevel; const aMsg : string);
     { ---------------------------------------------------------------------
         Low-level DB access.
       ---------------------------------------------------------------------}
 
+    // Create query object.
     function CreateQuery(const ASQL: String): TSQLQuery;
+    // create and open a query, return in Res.
     Function  OpenQuery (Qry : String; Out Res : TSQLQuery; Silent : Boolean) : Boolean ;
+    // Run query, return first field as integer. -1 on error or no data.
     Function  IDQuery(Qry : String) : Integer;
+    // Run query, return first field as int64. -1 on error or no data.
     Function  ID64Query(Qry : String) : Int64;
+    // Run query, return first field as string. Empty string on error or no data.
     Function  StringQuery(Qry : String) : String;
   Public
     { ---------------------------------------------------------------------
       High-level access
       ---------------------------------------------------------------------}
+    // Constructor.
     Constructor create(aDatabaseName,aHost,aUser,aPassword : String; aPort : Word);
+    // Destructor
     Destructor destroy; override;
+    // Try to connect to database with params given in constructor.
     Function ConnectToDatabase : Boolean;
-    Function  ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
+    // Disconnect from database
     Procedure DisconnectDatabase;
+    // Execute a query, return true if it executed without error.
+    Function  ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
     // Adding things
+    // Add a category.
     Function AddCategory(const aName : String) : Integer;
+    // Add a CPU.
     Function AddCPU(const aName : String) : Integer;
+    // Add an OS.
     Function AddOS(const aName : String) : Integer;
+    // Add a compiler version.
     function AddVersion(const aName: String; aReleaseDate: TDateTime): Integer;
+    // Add a platform.
     Function AddPlatform(const aData : TTestRunData) : Integer;
+    // Add a test and return the ID. If the test already exists, return it's ID
     Function AddTest(Name : String; AddSource : Boolean) : Integer;
+    // Add a test run. Return the test run ID.
     function AddRun(const aData: TTestRunData): Int64;
+    // Ad test result and return ID. If a result exists already for the given run/test, update and return ID.
     Function AddTestResult(aData : TTestResultData) : Int64;
+    // Add LastTestResult. If it exists already with given platform/test, update result ID.
     function AddLastResult(TestID, PlatformID: Integer; ResultID: Int64): Boolean;
-    // Get ID based on key
+    // Add previousTestResult. If it exists already with given platform/test, update result ID.
+    function AddPreviousResult(TestID, PlatformID: Integer; ResultID: Int64): Boolean;
+    //
+    // Get ID based on key. All keys are case sensitive. If a key does not exist, -1 is returned.
+    //
+    // Get test ID based on test name.
     Function GetTestID(Name : string) : Integer;
+    // Get OS ID based on OS name.
     Function GetOSID(Name : String) : Integer;
+    // Get CPU ID based on CPU name.
     Function GetCPUID(Name : String) : Integer;
+    // Get category ID based on Category name.
     Function GetCategoryID(Name : String) : Integer;
+    // Get version ID based on version name.
     Function GetVersionID(Name : String) : Integer;
+    // Get platform ID based on OS, cpu, category, config.
     function GetPlatformID(aData: TTestRunData; aAllowCreate: Boolean): Integer;
+    // Get run ID based on platform/date.
     Function GetRunID(aData : TTestRunData) : Int64;
+    // Get last test result ID based on platform/test.
     function GetLastTestResult(aTestID, aPlatFormID: Integer): TTestResultData;
-    //
+    // Update tests
     Function UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
     function UpdateTestResult(aData: TTestResultData): Int64;
     function UpdateTestRun(aData : TTestRunData): Boolean;
+    // Create test if it does not exist yet.
     Function RequireTestID(Name : String): Integer;
+    // Delete all results from a test run.
     Function CleanTestRun(ID : Integer) : Boolean;
+    // Escape SQL (quotes etc.
     Class Function  EscapeSQL(S : String) : String;
+    // return SQL date
     Class Function  SQLDate(D : TDateTime) : String;
+    // Rel src dir
     Property RelSrcDir : String Read FRelSrcDir Write FRelSrcDir;
+    // test src dir.
     Property TestSrcDir : string read FTestSrcDir Write FTestSrcDir;
-
+    // Prefix to use when logging (in case of multi-thread)
+    Property LogPrefix : String Read FLogPrefix Write FLogPrefix;
   end;
 
 
@@ -230,25 +270,30 @@ begin
     Result:=-1
   else
     Result:=Res.Fields[ID].AsInteger;
-  Verbose(V_SQL,'Field value '+IntToStr(Result));
+  testu.Verbose(V_SQL,'Field value '+IntToStr(Result));
 end;
 
 class function TTestSQL.GetInt64ResultField(Res: TSQLQuery; Id: Integer): Int64;
 begin
-  If (Res=Nil) or (ID>=Res.Fields.Count) then
+  If (Res=Nil) or (res.IsEmpty) or (ID>=Res.Fields.Count) then
     Result:=-1
   else
     Result:=Res.Fields[ID].AsLargeInt;
-  Verbose(V_SQL,'Field value '+IntToStr(Result));
+  testu.Verbose(V_SQL,'Field value '+IntToStr(Result));
 end;
 
 class function TTestSQL.GetStrResultField(Res: TSQLQuery; Id: Integer): String;
 begin
-  If (Res=Nil) or (ID>=Res.Fields.Count) then
+  If (Res=Nil) or (res.IsEmpty) or (ID>=Res.Fields.Count) then
     Result:=''
   else
     Result:=Res.Fields[ID].AsString;
-  Verbose(V_SQL,'Field value '+Result);
+  testu.Verbose(V_SQL,'Field value '+Result);
+end;
+
+procedure TTestSQL.Verbose(aLevel: TVerboseLevel; const aMsg: string);
+begin
+  testu.Verbose(aLevel,logPrefix+aMsg);
 end;
 
 function TTestSQL.AddPlatform(const aData : TTestRunData) : Integer;
@@ -335,7 +380,7 @@ class function TTestSQL.EscapeSQL(S: String): String;
 begin
 //  Result:=StringReplace(S,'\','\\',[rfReplaceAll]);
   Result:=StringReplace(S,'''','''''',[rfReplaceAll]);
-  Verbose(V_SQL,'EscapeSQL : "'+S+'" -> "'+Result+'"');
+  testu.Verbose(V_SQL,'EscapeSQL : "'+S+'" -> "'+Result+'"');
 end;
 
 
@@ -462,7 +507,7 @@ function TTestSQL.AddTest(Name: String; AddSource: Boolean): Integer;
 
 Const
   SInsertTest = 'INSERT INTO TESTS (T_NAME,T_ADDDATE)'+
-                ' VALUES (''%s'',NOW()) RETURNING T_ID';
+                ' VALUES (''%s'',NOW()) ON CONFLICT (T_NAME) DO UPDATE SET T_ADDDATE=NOW() RETURNING T_ID';
 
 Var
   Info : TConfig;
@@ -473,14 +518,17 @@ begin
   Result:=-1;
   lSrcDir:=IncludeTrailingPathDelimiter(TestSrcDir+RelSrcDir);
   lFileName:=ExpandFileName(lSrcDir+Name);
-  Verbose(V_Normal,'Checking test filename: '+lFileName);
-  If (FileExists(lFileName) and GetConfig(lFileName,Info))
-     or GetUnitTestConfig(Name,lSrcDir,Info) then
+  Verbose(V_Debug,'Checking test filename: '+lFileName);
+  Result:=IDQuery(Format(SInsertTest,[Name]));
+  If Result=-1 then
+    begin
+    Verbose(V_WARNING,'Could not add test!');
+    exit;
+    end;
+  If (FileExists(lFileName) and GetConfig(logprefix,lFileName,Info))
+     or GetUnitTestConfig(logprefix,Name,lSrcDir,Info) then
     begin
-    Result:=IDQuery(Format(SInsertTest,[Name]));
-    If Result=-1 then
-      Verbose(V_WARNING,'Could not add test!')
-    else If AddSource then
+    If AddSource then
       UpdateTest(Result,Info,testu.GetFileContents(Name))
     else
       UpdateTest(Result,Info,'');
@@ -578,14 +626,15 @@ begin
     Qry:=Format(SQLInsert, [TestID,RunID,Bools[OK],Bools[Skipped],Ord(TestResult),EscapeSQL(Log)]);
     end;
   Result:=ID64Query(Qry);
-  aData.ID:=Result;
 end;
 
 function TTestSQL.GetLastTestResult(aTestID, aPlatFormID: Integer): TTestResultData;
 
 Const
-  SQLSelect = 'SELECT TESTRESULTS.* FROM '+
-              ' TESTLASTRESULTS INNER JOIN TESTRESULTS ON (TL_TESTRESULTS_FK=TR_ID) '+
+  SQLSelect = 'SELECT TESTRESULTS.*, TU_DATE FROM '+
+              ' TESTLASTRESULTS '+
+              ' INNER JOIN TESTRESULTS ON (TL_TESTRESULTS_FK=TR_ID) '+
+              ' INNER JOIN TESTRUN ON (TR_TESTRUN_FK=TU_ID) '+
               'WHERE '+
               ' (TL_TEST_FK=%d) '+
               ' AND (TL_PLATFORM_FK=%d)';
@@ -606,6 +655,7 @@ begin
       Result.TestResult:=TTestStatus(Qry.FieldByName('TR_RESULT').AsInteger);
       Result.RunID:=Qry.FieldByName('TR_TESTRUN_FK').AsLargeInt;
       Result.Log:=Qry.FieldByName('TR_LOG').AsString;
+      Result.Date:=Qry.FieldByName('TU_DATE').AsDateTime;
       end
     else
       Result.ID:=-1;
@@ -631,6 +681,19 @@ begin
   Result:=ExecuteQuery(Format(SQLInsert,[TestId,PlatFormID,ResultID]),False);
 end;
 
+function TTestSQL.AddPreviousResult(TestID, PlatformID: Integer; ResultID: Int64): Boolean;
+const
+  SQLInsert = 'Insert into TESTPREVIOUSRESULTS '+
+             '  (TPR_TEST_FK,TPR_PLATFORM_FK,TPR_TESTRESULTS_FK) '+
+             'VALUES '+
+             '  (%d,%d,%d) '+
+             'ON CONFLICT (TPR_TEST_FK,TPR_PLATFORM_FK) '+
+             'DO UPDATE SET TPR_TESTRESULTS_FK = EXCLUDED.TPR_TESTRESULTS_FK ';
+
+begin
+  Result:=ExecuteQuery(Format(SQLInsert,[TestId,PlatFormID,ResultID]),False);
+end;
+
 function TTestSQL.UpdateTestRun(aData: TTestRunData): Boolean;
 var
   Qry : string;

tests/utils/digestanalyst.pas

@@ -31,27 +31,49 @@ Type
     UnknownLines : integer;
     UseLongLog : Boolean;
     FCurLongLogLine : Integer;
-    function CheckIDs(var aData: TTestRunData): Boolean;
+    FPrefix : String;
+    // Call global verbose with prefix to message.
+    procedure Verbose(aLevel : TVerboseLevel; const aMsg : string);
+    // Get the execute log for a given test
     function GetExecuteLog(Line, FN: String): String;
+    // Get the IDs from all config parameters: OS, Log,
     function GetIDs(const aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+    // Check that all IDS needed for a test run are <>-1
+    function CheckIDs(var aData: TTestRunData): Boolean;
+    // process a log file.
     procedure Processfile(const aFileName: String; var aData: TTestRunData);
-    function SaveTestResult(aResult: TTestResultData): Boolean;
+    // Update the test run statistics.
     procedure UpdateTestRun(const aData: TTestRunData);
+    // Get contents from longlog
     function GetContentsFromLongLog(Line: String): String;
+    // Get Log from file line
     function GetLog(Line, FN: String): String;
   public
-    constructor Create(aDB : TTestSQL);
+    constructor Create(aDB : TTestSQL; const aPrefix : String);
+    // Extract the status from a log line. Will change the log line.
     class function AnalyseLine(var Line: string; var Status: TTestStatus): Boolean;
+    // Extract test filename from a log line
     class procedure ExtractTestFileName(var Line: string);
+    // Analyse the file.
     procedure Analyse(aConfig : TDigestConfig; aData : TTestRunData);
+    // Save test result. Return true if a NEW test result record was created (and the result must be counted)
+    function SaveTestResult(var aResult: TTestResultData): Boolean;
+    // DB connection to use
+    property DB : TTestSQL read FDB;
   end;
 
 
 implementation
 
-constructor TDBDigestAnalyzer.Create(aDB: TTestSQL);
+constructor TDBDigestAnalyzer.Create(aDB: TTestSQL; const aPrefix: String);
 begin
   FDB:=aDB;
+  FPrefix:=aPrefix;
+end;
+
+procedure TDBDigestAnalyzer.Verbose(aLevel: TVerboseLevel; const aMsg: string);
+begin
+  testu.Verbose(aLevel,FPrefix+aMsg);
 end;
 
 function TDBDigestAnalyzer.CheckIDs(var aData : TTestRunData): Boolean;
@@ -63,11 +85,11 @@ begin
   if Result then
     exit;
   If aData.CPUID=-1 then
-    Verbose(V_Error,'NO ID for CPU "'+aData.CPU+'" found.');
+    Verbose(V_WARNING,'NO ID for CPU "'+aData.CPU+'" found.');
   If aData.OSID=-1 then
-    Verbose(V_Error,'NO ID for OS "'+aData.OS+'" found.');
+    Verbose(V_WARNING,'NO ID for OS "'+aData.OS+'" found.');
   If aData.VersionID=-1 then
-    Verbose(V_Error,'NO ID for version "'+aData.Version+'" found.');
+    Verbose(V_WARNING,'NO ID for version "'+aData.Version+'" found.');
 end;
 
 procedure TDBDigestAnalyzer.Analyse(aConfig: TDigestConfig; aData : TTestRunData);
@@ -273,22 +295,31 @@ begin
     end;
 end;
 
-function TDBDigestAnalyzer.SaveTestResult(aResult : TTestResultData) : Boolean;
+function TDBDigestAnalyzer.SaveTestResult(var aResult: TTestResultData): Boolean;
 
 var
   lLast : TTestResultData;
   lNewID : Int64;
 
 begin
+  Result:=False;
+  // Get last result for this test.
   lLast:=FDB.GetLastTestResult(aResult.TestID,aResult.PlatformID);
-  if aResult.Differs(lLast) then
+  if (aResult.Date<lLast.Date) then
+    exit; // Do not save earlier results
+  if not aResult.ResultDiffers(lLast) then
+    exit; // do not save identical results
+  // Need to save.
+  lNewID:=FDB.AddTestResult(aResult);
+  aResult.ID:=lNewId;
+  // Save current in lastresult
+  Result:=(LLast.ID<>lNewID);
+  if Result then
     begin
-    // Need to save
-    lNewID:=FDB.AddTestResult(aResult)
-    end
-  else
-    // Update status, testrun & log
-    FDB.UpdateTestResult(aResult);
+    // When new, save previous.
+    FDB.AddLastResult(aResult.TestID,aResult.PlatformID,lNewID);
+    FDB.AddPreviousResult(aResult.TestID,aResult.PlatformID,LLast.ID);
+    end;
 end;
 
 procedure TDBDigestAnalyzer.Processfile(const aFileName: String; var aData: TTestRunData);
@@ -297,8 +328,6 @@ var
   logfile : TStrings;
   fullline,line,prevLine : string;
   TS : TTestStatus;
-  Testlog : string;
-  count_test : boolean;
   lPrev,lResult : TTestResultData;
 
 begin
@@ -306,9 +335,13 @@ begin
   // init data common to the whole testrun
   lResult.RunID:=aData.RunID;
   lResult.PlatFormID:=aData.PlatFormID;
+  lResult.Date:=aData.Date;
   lPrev.RunID:=aData.RunID;
   lPrev.PlatformID:=aData.PlatformID;
   lPrev.TestID:=-1; // Init no test
+  lPrev.Date:=aData.Date;
+  for TS in TTestStatus do
+    aData.StatusCount[TS]:=0;
   PrevLine:='';
   logfile:=TStringList.Create;
   try
@@ -318,7 +351,8 @@ begin
       begin
         lResult:=Default(TTestResultData);
         line:=fullline;
-        lResult.TestResult:=stFailedToCompile;
+        TS:=stFailedToCompile;
+        lResult.TestResult:=TS;
         If not AnalyseLine(line,TS) then
           begin
           Inc(UnknownLines);
@@ -364,7 +398,8 @@ begin
                 end
               else
                 lResult.Log:='';
-              SaveTestResult(lResult);
+              if SaveTestResult(lResult) then
+                Inc(aData.StatusCount[TS]);
               end;
             end
           end

tests/utils/testsuite.sql

@@ -57,9 +57,9 @@ CREATE SEQUENCE SEQ_TESTS as INT start with 1;
 
 CREATE TABLE TESTS (
   T_ID int NOT NULL default nextval('SEQ_TESTS'),
-  T_NAME varchar(40),
-  T_CPU varchar(20),
-  T_OS varchar(30),
+  T_NAME varchar(127),
+  T_CPU varchar(127),
+  T_OS varchar(127),
   T_VERSION varchar(10),
   T_ADDDATE date NOT NULL,
   T_GRAPH boolean NOT NULL default 'f',

tests/utils/testu.pp

@@ -92,7 +92,8 @@ type
     RunID : Int64;
     TestResult : TTestStatus;
     Log : String;
-    function Differs(aResult : TTestResultData; CompareLog : Boolean = False) : Boolean;
+    Date : TDateTime;
+    function ResultDiffers(aResult : TTestResultData; CompareLog : Boolean = False) : Boolean;
   end;
 
 
@@ -106,9 +107,9 @@ procedure TrimB(var s:string);
 procedure TrimE(var s:string);
 function upper(const s : string) : string;
 procedure Verbose(lvl:TVerboseLevel;const s:string);
-function GetConfig(const fn:string;var r:TConfig):boolean;
+function GetConfig(const logprefix,fn:string;var r:TConfig):boolean;
 Function GetFileContents (FN : String) : String;
-function GetUnitTestConfig(const fn,SrcDir: string; var r : TConfig) : Boolean;
+function GetUnitTestConfig(const logprefix,fn,SrcDir: string; var r : TConfig) : Boolean;
 
 const
 { Constants used in IsAbsolute function }
@@ -276,6 +277,7 @@ begin
         halt(0);
       end;
   end;
+  Flush(output);
 end;
 
 procedure TrimB(var s:string);
@@ -307,7 +309,7 @@ begin
      Result[i]:=s[i];
 end;
 
-function GetConfig(const fn:string;var r:TConfig):boolean;
+function GetConfig(const logprefix,fn:string;var r:TConfig):boolean;
 var
   t : text;
   part,code : integer;
@@ -558,7 +560,7 @@ begin
   Close(F);
 end;
 
-function GetUnitTestConfig(const fn,SrcDir : string; var r : TConfig) : Boolean;
+function GetUnitTestConfig(const logprefix,fn,SrcDir : string; var r : TConfig) : Boolean;
 
 var
   Path       : string;
@@ -598,7 +600,7 @@ begin
     exit;
   Src:=TStringList.Create;
   try
-    Verbose(V_Debug,'Reading: '+FileName);
+    Verbose(V_Debug,logprefix+'Reading: '+FileName);
     Src.LoadFromFile(FileName);
     for Line in Src do
       if Line<>'' then
@@ -626,7 +628,7 @@ end;
 
 { TTestResultData }
 
-function TTestResultData.Differs(aResult: TTestResultData; CompareLog: Boolean): Boolean;
+function TTestResultData.ResultDiffers(aResult: TTestResultData; CompareLog: Boolean): Boolean;
 begin
   Result:=(PlatformID<>aResult.PlatFormID);
   Result:=Result or (TestID<>aResult.TestID);

tests/utils/unittests/tcanalyst.pas

@@ -0,0 +1,193 @@
+unit tcanalyst;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, testu, dbtests, tresults, sqldb, digestanalyst, pqconnection, tcsetup, tctestsql;
+
+type
+
+  { TTestAnalyst }
+
+  TTestAnalyst = class(TTestBaseSQLCase)
+  private
+    FAnalyst: TDBDigestAnalyzer;
+    FSQL: TTestSQL;
+  protected
+    function GetSQL: TTestSQL; override;
+  public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Analyst : TDBDigestAnalyzer read FAnalyst;
+
+  Published
+    Procedure TestHookup;
+    procedure TestSaveResultsIdentical;
+    procedure TestSaveResultsDifferSameDate;
+    procedure TestSaveResultsDifferOlderDate;
+    procedure TestSaveResultsDifferNewerDate;
+  end;
+
+implementation
+
+{ TTestAnalyst }
+
+function TTestAnalyst.GetSQL: TTestSQL;
+begin
+  Result:=FSQL;
+end;
+
+procedure TTestAnalyst.SetUp;
+begin
+  inherited SetUp;
+  if not Assigned(TDBHelper.SQL) then
+    TDBHelper.Setup;
+  FSQL:=TDBHelper.SQL;
+  FAnalyst:=TDBDigestAnalyzer.Create(FSQL);
+  TDBHelper.ClearAllTables;
+end;
+
+procedure TTestAnalyst.TearDown;
+begin
+  FreeAndNil(FAnalyst);
+  FSQL:=Nil;
+  inherited TearDown;
+end;
+
+procedure TTestAnalyst.TestHookup;
+begin
+  AssertNotNull('SQL',SQL);
+  AssertNotNull('Analyst',Analyst);
+  AssertSame('Analyst SQL',SQL,Analyst.DB);
+end;
+
+procedure TTestAnalyst.TestSaveResultsDifferSameDate;
+var
+  lData : TTestRunData;
+  lResults2,lResults : TTestResultData;
+  lResultID : Int64;
+
+begin
+  lResultID:=CreateResultData(lData,lResults,1);
+  SQL.AddLastResult(lResults.TestID,lData.PlatformID,lResultID);
+  AssertEquals('count TESTRESULTS before',1,TDBHelper.CountRecords('TESTRESULTS'));
+  AssertEquals('count TESTLASTRESULTS before',1,TDBHelper.CountRecords('TESTLASTRESULTS'));
+  AssertEquals('count TESTPREVIOUSRESULTS before',0,TDBHelper.CountRecords('TESTPREVIOUSRESULTS'));
+  AssertTrue('Have iD',lResultID>0);
+  lResults.ID:=0;
+  lResults.TestResult:=TTestStatus.stFailedToRun;
+  AssertFalse('No new record for identical date',Analyst.SaveTestResult(lResults));
+  AssertEquals('count TESTRESULTS after identical date ',1,TDBHelper.CountRecords('TESTRESULTS'));
+  AssertEquals('count TESTLASTRESULTS before',1,TDBHelper.CountRecords('TESTLASTRESULTS'));
+  AssertEquals('count TESTPREVIOUSRESULTS before',0,TDBHelper.CountRecords('TESTPREVIOUSRESULTS'));
+  lResults2:=SQL.GetLastTestResult(lResults.TestID,lData.PlatformID);
+  AssertTrue('Existing record was updated',lResults2.TestResult=lResults.TestResult);
+end;
+
+procedure TTestAnalyst.TestSaveResultsDifferOlderDate;
+var
+  lData : TTestRunData;
+  lResults2,lResults : TTestResultData;
+  lResultID : Int64;
+
+begin
+  lResultID:=CreateResultData(lData,lResults,1);
+  SQL.AddLastResult(lResults.TestID,lData.PlatformID,lResultID);
+  AssertEquals('count TESTRESULTS before',1,TDBHelper.CountRecords('TESTRESULTS'));
+  AssertEquals('count TESTLASTRESULTS before',1,TDBHelper.CountRecords('TESTLASTRESULTS'));
+  AssertEquals('count TESTPREVIOUSRESULTS before',0,TDBHelper.CountRecords('TESTPREVIOUSRESULTS'));
+  AssertTrue('Have iD',lResultID>0);
+  // Simulate new run, but on older date
+  lData.Date:=Date-2;
+  lData.RunID:=SQL.AddRun(lData);
+  // test result
+  lResults.ID:=0;
+  lResults.RunID:=lData.RunID;
+  lResults.TestResult:=TTestStatus.stFailedToRun;
+  lResults.Date:=Date-2;
+  AssertFalse('No new record for identical date',Analyst.SaveTestResult(lResults));
+  AssertEquals('count TESTRESULTS after identical date ',1,TDBHelper.CountRecords('TESTRESULTS'));
+  AssertEquals('count TESTLASTRESULTS before',1,TDBHelper.CountRecords('TESTLASTRESULTS'));
+  AssertEquals('count TESTPREVIOUSRESULTS before',0,TDBHelper.CountRecords('TESTPREVIOUSRESULTS'));
+  lResults2:=SQL.GetLastTestResult(lResults.TestID,lData.PlatformID);
+  AssertTrue('Existing record was not updated',lResults2.TestResult<>lResults.TestResult);
+end;
+
+procedure TTestAnalyst.TestSaveResultsDifferNewerDate;
+
+
+var
+  lData : TTestRunData;
+  lResults2,lResults : TTestResultData;
+  lResultID : Int64;
+
+begin
+  lResultID:=CreateResultData(lData,lResults,1);
+  SQL.AddLastResult(lResults.TestID,lData.PlatformID,lResultID);
+  AssertEquals('count TESTRESULTS before',1,TDBHelper.CountRecords('TESTRESULTS'));
+  AssertEquals('count TESTLASTRESULTS before',1,TDBHelper.CountRecords('TESTLASTRESULTS'));
+  AssertEquals('count TESTPREVIOUSRESULTS before',0,TDBHelper.CountRecords('TESTPREVIOUSRESULTS'));
+  AssertTrue('Have iD',lResultID>0);
+  // Simulate new run
+  lData.Date:=Date;
+  lData.RunID:=SQL.AddRun(lData);
+  // test result
+  lResults.ID:=0;
+  lResults.RunID:=lData.RunID;
+  lResults.TestResult:=TTestStatus.stFailedToRun;
+  lResults.Date:=Date;
+  AssertTrue('new record for identical date',Analyst.SaveTestResult(lResults));
+  AssertEquals('count TESTRESULTS after ',2,TDBHelper.CountRecords('TESTRESULTS'));
+  // these remain the same, the platform/test is the same...
+  AssertEquals('count TESTLASTRESULTS after',1,TDBHelper.CountRecords('TESTLASTRESULTS'));
+  AssertEquals('count TESTPREVIOUSRESULTS after',1,TDBHelper.CountRecords('TESTPREVIOUSRESULTS'));
+  lResults2:=SQL.GetLastTestResult(lResults.TestID,lData.PlatformID);
+  AssertEquals('Existing record was updated (id)',lResults.ID,lResults2.ID);
+  AssertTrue('New record was marked as last (status)',lResults2.TestResult=lResults.TestResult);
+end;
+
+procedure TTestAnalyst.TestSaveResultsIdentical;
+
+var
+  lData : TTestRunData;
+  lResults2,lResults : TTestResultData;
+  lResultID : Int64;
+
+begin
+  lResultID:=CreateResultData(lData,lResults,1);
+  SQL.AddLastResult(lResults.TestID,lData.PlatformID,lResultID);
+  AssertEquals('count TESTRESULTS before',1,TDBHelper.CountRecords('TESTRESULTS'));
+  AssertEquals('count TESTLASTRESULTS before',1,TDBHelper.CountRecords('TESTLASTRESULTS'));
+  AssertEquals('count TESTPREVIOUSRESULTS before',0,TDBHelper.CountRecords('TESTPREVIOUSRESULTS'));
+  AssertTrue('Have iD',lResultID>0);
+  lResults.ID:=0;
+  AssertFalse('No new record for identical',Analyst.SaveTestResult(lResults));
+  AssertEquals('count TESTRESULTS after identical',1,TDBHelper.CountRecords('TESTRESULTS'));
+  AssertEquals('count TESTLASTRESULTS before',1,TDBHelper.CountRecords('TESTLASTRESULTS'));
+  AssertEquals('count TESTPREVIOUSRESULTS before',0,TDBHelper.CountRecords('TESTPREVIOUSRESULTS'));
+
+(*
+lResults.TestResult:=TTestStatus.stFailedToRun;
+  AssertFalse('No new record for same test date',Analyst.SaveTestResult(lResults));
+  lResults2:=SQL.GetLastTestResult(lResults.TestID,lData.PlatformID);
+  AssertTrue('Existing record was updated');
+
+  lResults.Date:=Date;
+  lData.Date:=Date;
+  lData.RunID:=SQL.AddRun(lData);
+  lResults.RunID:=lData.RunID;
+
+  AssertTrue('new record for different result&test date',Analyst.SaveTestResult(lResults));
+  AssertEquals('count TESTLASTRESULTS after differ',2,TDBHelper.CountRecords('TESTRESULTS'));
+  AssertEquals('count TESTLASTRESULTS after differ',2,TDBHelper.CountRecords('TESTLASTRESULTS'));
+  AssertEquals('count TESTPREVIOUSRESULTS after differ ',1,TDBHelper.CountRecords('TESTLASTRESULTS'));
+*)
+end;
+
+begin
+  Registertest(TTestAnalyst);
+
+end.
+

tests/utils/unittests/tcsetup.pas

@@ -15,7 +15,9 @@ type
     class var Conn : TPQConnection;
     class function CreateQuery(const aSQL : String) : TSQLQuery;
     class procedure setup;
+    class procedure TearDown;
     class procedure ClearTable(const aTable : string);
+    class procedure ClearAllTables;
     class function IDQuery(const aSQL : String) : Int64;
     class procedure ExecAndCommit(Qry: TSQLQuery);
     class procedure ExecSQL(const aSQL: String);
@@ -104,6 +106,12 @@ begin
   *)
 end;
 
+class procedure TDBHelper.TearDown;
+begin
+  FreeAndNil(SQL);
+  FreeAndNil(Conn);
+end;
+
 class procedure TDBHelper.ExecAndCommit(Qry : TSQLQuery);
 
 begin
@@ -157,6 +165,20 @@ begin
   ExecSQL('delete from '+aTable);
 end;
 
+class procedure TDBHelper.ClearAllTables;
+begin
+  ClearTable('TESTOS');
+  ClearTable('TESTCPU');
+  ClearTable('TESTCATEGORY');
+  ClearTable('TESTVERSION');
+  ClearTable('TESTPLATFORM');
+  ClearTable('TESTRUN');
+  ClearTable('TESTS');
+  ClearTable('TESTRESULTS');
+  ClearTable('TESTLASTRESULTS');
+  ClearTable('TESTPREVIOUSRESULTS');
+end;
+
 class function TDBHelper.IDQuery(const aSQL: String): Int64;
 
 var
@@ -191,8 +213,7 @@ end;
 
 procedure TDBDecorator.OneTimeTearDown;
 begin
-  FreeAndNil(TDBHelper.SQL);
-  FreeAndNil(TDBHelper.Conn);
+  TDBHelper.TearDown;
 end;
 
 

tests/utils/unittests/tctestsql.pas

@@ -11,24 +11,29 @@ const
   Bools : Array[Boolean] of string = ('f','t');
 
 type
+  { TTestSQLCase }
 
+  { TTestBaseSQLCase }
 
-  { TTestSQLCase }
+  TTestBaseSQLCase = class(TTestCase)
+  Protected
+    function CreateResultData(out aData: TTestRunData; out aResult: TTestResultData; DateOffset: Integer = 0): Int64;
+    function PreparePlatform(var aData: TTestRunData): Integer;
+    procedure CreateSource(const aFileName : String);
+    procedure DeleteSource(const aFileName: String);
+    procedure AssertTestRunData(aQry: TSQLQuery; aData: TTestRunData);
+    function GetSQL: TTestSQL; virtual; abstract;
+    property SQL : TTestSQL Read GetSQL;
+  end;
 
-  TTestSQLCase= class(TTestCase)
+  TTestSQLCase = class(TTestBaseSQLCase)
   const
     SQLTestResultFilter = '(TR_ID=%d) and (TR_TESTRUN_FK=%d) and (TR_TEST_FK=%d) and (TR_OK=''%s'') and (TR_SKIP=''%s'') and (TR_RESULT=%d) and (TR_LOG=''%s'')';
-  private
-    procedure AssertTestRunData(aQry: TSQLQuery; aData: TTestRunData);
-    function CreateResultData(out aData: TTestRunData; out aResult: TTestResultData; DateOffset: Integer = 0): Int64;
-    procedure DeleteSource(const aFileName: String);
-    function GetSQL: TTestSQL;
-    function PreparePlatform(var aData: TTestRunData): Integer;
+  protected
+    function GetSQL: TTestSQL; override;
   protected
     procedure SetUp; override;
     procedure TearDown; override;
-    procedure CreateSource(const aFileName : String);
-    property SQL : TTestSQL Read GetSQL;
   published
     procedure TestHookUp;
     procedure TestAddCPU;
@@ -45,6 +50,8 @@ type
     Procedure TestAddLastResult;
     Procedure TestAddLastResultTwice;
     Procedure TestGetLastTestResult;
+    Procedure TestAddPreviousResult;
+    Procedure TestAddPreviousResultTwice;
     procedure TestGetCPUID;
     procedure TestGetOSID;
     procedure TestGetCategoryID;
@@ -59,6 +66,105 @@ implementation
 
 uses tcsetup;
 
+{ TTestBaseSQLCase }
+
+
+procedure TTestBaseSQLCase.DeleteSource(const aFileName: String);
+begin
+  if FileExists(aFilename+'.pp') then
+    if not DeleteFile(aFilename+'.pp') then
+      Fail('Failed to delete '+aFileName+'.pp');
+end;
+
+procedure TTestBaseSQLCase.CreateSource(const aFileName: String);
+var
+  Src : TStrings;
+begin
+  Src:=TStringList.Create;
+  try
+    Src.Add('program '+aFileName+';');
+    Src.Add('begin');
+    Src.Add('end.');
+    Src.SaveToFile(afileName+'.pp');
+  finally
+    Src.Free;
+  end;
+end;
+
+function TTestBaseSQLCase.PreparePlatform(var aData : TTestRunData) : Integer;
+
+begin
+  aData.CategoryID:=SQL.GetCategoryID('x');
+  if aData.CategoryID=-1 then
+    aData.CategoryID:=SQL.AddCategory('x');
+
+  aData.OSID:=SQL.GetOSID('y');
+  if aData.OSID=-1 then
+    aData.OSID:=SQL.AddOS('y');
+
+  aData.CPUID:=SQL.GetCPUID('z');
+  if aData.CPUID=-1 then
+    aData.CPUID:=SQL.AddCPU('z');
+
+  aData.VersionID:=SQL.GetVersionID('w');
+  if aData.VersionID=-1 then
+    aData.VersionID:=SQL.AddVersion('w',Date);
+
+  aData.config:='v';
+  Result:=SQL.GetPlatformID(aData,False);
+  if Result=-1 then
+    Result:=SQL.AddPlatform(aData);
+end;
+
+procedure TTestBaseSQLCase.AssertTestRunData(aQry : TSQLQuery; aData : TTestRunData);
+
+var
+  St : TTestStatus;
+
+begin
+  With aQry,aData do
+    begin
+    AssertEquals('Date',DATE,FieldByName('TU_DATE').AsDateTime);
+    AssertEquals('Platform',PlatformID,FieldByName('TU_PLATFORM_FK').AsInteger);
+    AssertEquals('Machine',Machine,FieldByName('TU_MACHINE').AsString);
+    AssertEquals('Submitter',Submitter,FieldByName('TU_SUBMITTER').AsString);
+    For St in TTestStatus do
+      AssertEquals(StatusText[St],StatusCount[st],FieldByName(SQLField[ST]).AsInteger);
+    AssertEquals('CompilerDate',CompilerDate,FieldByName('TU_COMPILERDATE').AsString);
+    AssertEquals('CompilerFullVersion',CompilerFullVersion,FieldByName('TU_COMPILERFULLVERSION').AsString);
+    AssertEquals('CompilerRevision',CompilerRevision,FieldByName('TU_COMPILERREVISION').AsString);
+    AssertEquals('TestsRevision',TestsRevision,FieldByName('TU_TESTSREVISION').AsString);
+    AssertEquals('RTLRevision',RTLRevision,FieldByName('TU_RTLREVISION').AsString);
+    AssertEquals('PackagesRevision',PackagesRevision,FieldByName('TU_PACKAGESREVISION').AsString);
+    end;
+end;
+
+function TTestBaseSQLCase.CreateResultData(out aData: TTestRunData; out aResult: TTestResultData; DateOffset: Integer): Int64;
+
+begin
+  aData:=Default(TTestRunData);
+  aData.PlatformID:=PreparePlatform(aData);
+  aData.Date:=Date-DateOffset;
+  aData.RunID:=SQL.AddRun(aData);
+  aResult:=Default(TTestResultData);
+  aResult.RunID:=aData.RunID;
+  aResult.PlatformID:=aData.PlatformID;
+  aResult.Date:=Date-DateOffset;
+  CreateSource('x');
+  if SQL.GetTestID('x.pp')=-1 then
+    aResult.TestID:=SQL.AddTest('x.pp',False);
+  aResult.TestResult:=stSuccessCompilationFailed;
+  aResult.Log:='xyz';
+  With aData do
+    begin
+    Result:=SQL.AddTestResult(aResult);
+    aResult.ID:=Result;
+    end;
+end;
+
+
+{ TTestSQLCase }
+
 procedure TTestSQLCase.TestHookUp;
 begin
   AssertEquals('Empty testos',0,TDBHelper.CountRecords('TESTOS'));
@@ -114,30 +220,6 @@ begin
   AssertEquals('exists',1,TDBHelper.CountRecords('TESTS',Format('(T_ID=%d) and (t_name=''x.pp'')',[lID])));
 end;
 
-function TTestSQLCase.PreparePlatform(var aData : TTestRunData) : Integer;
-
-begin
-  aData.CategoryID:=SQL.GetCategoryID('x');
-  if aData.CategoryID=-1 then
-    aData.CategoryID:=SQL.AddCategory('x');
-
-  aData.OSID:=SQL.GetOSID('y');
-  if aData.OSID=-1 then
-    aData.OSID:=SQL.AddOS('y');
-
-  aData.CPUID:=SQL.GetCPUID('z');
-  if aData.CPUID=-1 then
-    aData.CPUID:=SQL.AddCPU('z');
-
-  aData.VersionID:=SQL.GetVersionID('w');
-  if aData.VersionID=-1 then
-    aData.VersionID:=SQL.AddVersion('w',Date);
-
-  aData.config:='v';
-  Result:=SQL.GetPlatformID(aData,False);
-  if Result=-1 then
-    Result:=SQL.AddPlatform(aData);
-end;
 
 procedure TTestSQLCase.TestAddPlatform;
 
@@ -156,28 +238,6 @@ begin
   AssertEquals('Platform',1,TDBHelper.CountRecords('TESTPLATFORM',Flt));
 end;
 
-procedure TTestSQLCase.AssertTestRunData(aQry : TSQLQuery; aData : TTestRunData);
-
-var
-  St : TTestStatus;
-
-begin
-  With aQry,aData do
-    begin
-    AssertEquals('Date',DATE,FieldByName('TU_DATE').AsDateTime);
-    AssertEquals('Platform',PlatformID,FieldByName('TU_PLATFORM_FK').AsInteger);
-    AssertEquals('Machine',Machine,FieldByName('TU_MACHINE').AsString);
-    AssertEquals('Submitter',Submitter,FieldByName('TU_SUBMITTER').AsString);
-    For St in TTestStatus do
-      AssertEquals(StatusText[St],StatusCount[st],FieldByName(SQLField[ST]).AsInteger);
-    AssertEquals('CompilerDate',CompilerDate,FieldByName('TU_COMPILERDATE').AsString);
-    AssertEquals('CompilerFullVersion',CompilerFullVersion,FieldByName('TU_COMPILERFULLVERSION').AsString);
-    AssertEquals('CompilerRevision',CompilerRevision,FieldByName('TU_COMPILERREVISION').AsString);
-    AssertEquals('TestsRevision',TestsRevision,FieldByName('TU_TESTSREVISION').AsString);
-    AssertEquals('RTLRevision',RTLRevision,FieldByName('TU_RTLREVISION').AsString);
-    AssertEquals('PackagesRevision',PackagesRevision,FieldByName('TU_PACKAGESREVISION').AsString);
-    end;
-end;
 
 procedure TTestSQLCase.TestAddRun;
 var
@@ -212,23 +272,6 @@ begin
   end;
 end;
 
-function TTestSQLCase.CreateResultData(out aData: TTestRunData; out aResult: TTestResultData; DateOffset: Integer): Int64;
-
-begin
-  aData:=Default(TTestRunData);
-  aData.PlatformID:=PreparePlatform(aData);
-  aData.Date:=Date-DateOffset;
-  aData.RunID:=SQL.AddRun(aData);
-  aResult:=Default(TTestResultData);
-  aResult.RunID:=aData.RunID;
-  CreateSource('x');
-  if SQL.GetTestID('x.pp')=-1 then
-    aResult.TestID:=SQL.AddTest('x.pp',False);
-  aResult.TestResult:=stSuccessCompilationFailed;
-  aResult.Log:='xyz';
-  With aData do
-    Result:=SQL.AddTestResult(aResult);
-end;
 
 procedure TTestSQLCase.TestAddTestResult;
 
@@ -324,7 +367,6 @@ begin
   AssertTrue('Add',SQL.AddLastResult(lResult.TestID,lData.PlatformID,lID2));
   flt:=Format('(TL_TEST_FK=%d) and (TL_PLATFORM_FK=%d) and (TL_TESTRESULTS_FK=%d)',[lResult.TestID,lData.PlatformID,lID2]);
   AssertEquals('Result',1,TDBHelper.CountRecords('TESTLASTRESULTS',Flt));
-
 end;
 
 procedure TTestSQLCase.TestGetLastTestResult;
@@ -333,13 +375,43 @@ var
   lResult2,lResult : TTestResultData;
   lID : Integer;
 begin
-  lID:=CreateResultData(lData,lResult);
+  lID:=CreateResultData(lData,lResult,1);
   AssertTrue('Add',SQL.AddLastResult(lResult.TestID,lData.PlatformID,lID));
   lResult2:=SQL.GetLastTestResult(lResult.TestID,lData.PlatformID);
   AssertEquals('ID',lID,lResult2.ID);
   AssertEquals('Run',lResult.RunID,lResult2.RunID);
   AssertTrue('Status',lResult.TestResult=lResult2.TestResult);
   AssertEquals('Log',lResult.Log,lResult2.Log);
+  AssertEquals('Date',Date-1,lResult2.Date);
+end;
+
+procedure TTestSQLCase.TestAddPreviousResult;
+var
+  lData : TTestRunData;
+  lResult : TTestResultData;
+  lID : Int64;
+  flt : String;
+
+begin
+  lID:=CreateResultData(lData,lResult);
+  AssertTrue('Add',SQL.AddPreviousResult(lResult.TestID,lData.PlatformID,lID));
+  flt:=Format('(TPR_TEST_FK=%d) and (TPR_PLATFORM_FK=%d) and (TPR_TESTRESULTS_FK=%d)',[lResult.TestID,lData.PlatformID,lID]);
+  AssertEquals('Result',1,TDBHelper.CountRecords('TESTPREVIOUSRESULTS',Flt));
+end;
+
+procedure TTestSQLCase.TestAddPreviousResultTwice;
+var
+  lData : TTestRunData;
+  lResult : TTestResultData;
+  lID,lID2 : Integer;
+  flt : string;
+begin
+  lID:=CreateResultData(lData,lResult,1);
+  AssertTrue('Add',SQL.AddPreviousResult(lResult.TestID,lData.PlatformID,lID));
+  lID2:=CreateResultData(lData,lResult,0);
+  AssertTrue('Add',SQL.AddPreviousResult(lResult.TestID,lData.PlatformID,lID2));
+  flt:=Format('(TPR_TEST_FK=%d) and (TPR_PLATFORM_FK=%d) and (TPR_TESTRESULTS_FK=%d)',[lResult.TestID,lData.PlatformID,lID2]);
+  AssertEquals('Result',1,TDBHelper.CountRecords('TESTPREVIOUSRESULTS',Flt));
 end;
 
 procedure TTestSQLCase.TestUpdateRun;
@@ -439,16 +511,7 @@ end;
 
 procedure TTestSQLCase.SetUp;
 begin
-  TDBHelper.ClearTable('TESTOS');
-  TDBHelper.ClearTable('TESTCPU');
-  TDBHelper.ClearTable('TESTCATEGORY');
-  TDBHelper.ClearTable('TESTVERSION');
-  TDBHelper.ClearTable('TESTPLATFORM');
-  TDBHelper.ClearTable('TESTRUN');
-  TDBHelper.ClearTable('TESTS');
-  TDBHelper.ClearTable('TESTRESULTS');
-  TDBHelper.ClearTable('TESTLASTRESULTS');
-  TDBHelper.ClearTable('TESTPREVIOUSRESULTS');
+  TDBHelper.ClearAllTables;
   SQL.TestSrcDir:='./';
 end;
 
@@ -458,27 +521,6 @@ begin
   DeleteSource('x');
 end;
 
-procedure TTestSQLCase.DeleteSource(const aFileName: String);
-begin
-  if FileExists(aFilename+'.pp') then
-    if not DeleteFile(aFilename+'.pp') then
-      Fail('Failed to delete '+aFileName+'.pp');
-end;
-procedure TTestSQLCase.CreateSource(const aFileName: String);
-var
-  Src : TStrings;
-begin
-  Src:=TStringList.Create;
-  try
-    Src.Add('program '+aFileName+';');
-    Src.Add('begin');
-    Src.Add('end.');
-    Src.SaveToFile(afileName+'.pp');
-  finally
-    Src.Free;
-  end;
-end;
-
 
 
 initialization

tests/utils/unittests/testdbdigest.lpi

@@ -44,6 +44,10 @@
         <Filename Value="../digestanalyst.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="tcanalyst.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

tests/utils/unittests/testdbdigest.lpr

@@ -3,7 +3,7 @@ program testdbdigest;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, tctestsql, dbtests, digestanalyst, tcsetup;
+  Classes, consoletestrunner, tctestsql, dbtests, digestanalyst, tcsetup, tcanalyst;
 
 type