* New test DB

tests/utils/dbdigest.lpi

@@ -0,0 +1,59 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="FPC Digest Application"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="dbdigest.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="digestanalyst.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="dbdigest"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

tests/utils/dbtests.pp

@@ -6,105 +6,120 @@ unit dbtests;
 Interface
 
 Uses
-  sqldb, testu;
-
-{ ---------------------------------------------------------------------
-  High-level access
-  ---------------------------------------------------------------------}
-
-Function GetTestID(Name : string) : Integer;
-Function GetOSID(Name : String) : Integer;
-Function GetCPUID(Name : String) : Integer;
-Function GetCategoryID(Name : String) : Integer;
-Function GetVersionID(Name : String) : Integer;
-Function GetRunID(OSID, CPUID, VERSIONID : Integer; Date : TDateTime) : Integer;
-Function AddRun(OSID, CPUID, VERSIONID, CATEGORYID : Integer; Date : TDateTime) : Integer;
-Function AddTest(Name : String; AddSource : Boolean) : Integer;
-Function UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
-Function AddTestResult(TestID,RunID,TestRes : Integer;
-                       OK, Skipped : Boolean;
-                       Log : String;var count_it : boolean) : Integer;
-Function RequireTestID(Name : String): Integer;
-Function CleanTestRun(ID : Integer) : Boolean;
-function GetTestPreviousRunHistoryID(TestRunID : Integer) : Integer;
-function GetTestNextRunHistoryID(TestRunID : Integer) : Integer;
-function AddTestHistoryEntry(TestRunID,TestPreviousID : Integer) : boolean;
-
-{ ---------------------------------------------------------------------
-    Low-level DB access.
-  ---------------------------------------------------------------------}
-
-Function  ConnectToDatabase(DatabaseName,Host,User,Password,Port : String) : Boolean;
-Procedure DisconnectDatabase;
-Function  InsertQuery(const Query : string) : Integer;
-Function  ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
-Function  OpenQuery (Qry : String; Out Res : TSQLQuery; Silent : Boolean) : Boolean ;
-Procedure FreeQueryResult (Var Res : TSQLQuery);
-Function  GetResultField (Res : TSQLQuery; Id : Integer) : String;
-Function  IDQuery(Qry : String) : Integer;
-Function  StringQuery(Qry : String) : String;
-Function  EscapeSQL( S : String) : String;
-Function  SQLDate(D : TDateTime) : String;
+  sqldb, testu, pqconnection;
+
+Type
+
+  { TTestSQL }
+
+  TTestSQL = class(TObject)
+  private
+    FRelSrcDir: String;
+    FTestSrcDir: string;
+    FConnection : TPQConnection;
+    FDatabaseName : String;
+    FHost : String;
+    FUser : String;
+    FPassword : String;
+    FPort : 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;
+    function GetUnitTestConfig(const fn : string; var r : TConfig) : Boolean;
+    { ---------------------------------------------------------------------
+        Low-level DB access.
+      ---------------------------------------------------------------------}
+
+    function CreateQuery(const ASQL: String): TSQLQuery;
+    Function  InsertQuery(const Query : string) : Integer;
+    Function  ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
+    Function  OpenQuery (Qry : String; Out Res : TSQLQuery; Silent : Boolean) : Boolean ;
+    Function  IDQuery(Qry : String) : Integer;
+    Function  ID64Query(Qry : String) : Int64;
+    Function  StringQuery(Qry : String) : String;
+  Public
+    { ---------------------------------------------------------------------
+      High-level access
+      ---------------------------------------------------------------------}
+    Constructor create (aDatabaseName,aHost,aUser,aPassword,aPort : String);
+    Function ConnectToDatabase : Boolean;
+    Procedure DisconnectDatabase;
+    Function GetTestID(Name : string) : Integer;
+    Function GetOSID(Name : String) : Integer;
+    Function GetCPUID(Name : String) : Integer;
+    Function GetCategoryID(Name : String) : Integer;
+    Function GetVersionID(Name : String) : Integer;
+    Function GetRunID(OSID, CPUID, VERSIONID : Integer; Date : TDateTime) : Integer;
+    Function AddRun(OSID, CPUID, VERSIONID, CATEGORYID : Integer; Date : TDateTime) : Integer;
+    Function AddTest(Name : String; AddSource : Boolean) : Integer;
+    Function UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
+    Function AddTestResult(TestID,RunID,TestRes : Integer;
+                           OK, Skipped : Boolean;
+                           Log : String;var count_it : boolean) : Int64;
+    Function RequireTestID(Name : String): Integer;
+    Function CleanTestRun(ID : Integer) : Boolean;
+
+    Class Function  EscapeSQL( S : String) : String;
+    Class Function  SQLDate(D : TDateTime) : String;
+    Property RelSrcDir : String Read FRelSrcDir Write FRelSrcDir;
+    Property TestSrcDir : string read FTestSrcDir Write FTestSrcDir;
 
+  end;
 
-var
-  RelSrcDir,
-  TestSrcDir : string;
 
 Implementation
 
 Uses
-  SysUtils, pqconnection;
-
-Var
-  Connection : TPQConnection;
+  SysUtils;
 
 { ---------------------------------------------------------------------
     Low-level DB access.
   ---------------------------------------------------------------------}
 
-Function ConnectToDatabase(DatabaseName,Host,User,Password,Port : String) : Boolean;
+function TTestSQL.ConnectToDatabase: Boolean;
 
 begin
   Result:=False;
-  Verbose(V_SQL,'Connection params : '+DatabaseName+' '+Host+' '+User+' '+Port);
-  Connection:=TPQConnection.Create(Nil);
+  Verbose(V_SQL,'Connection params : '+FDatabaseName+' '+FHost+' '+FUser+' '+FPort);
+  FConnection:=TPQConnection.Create(Nil);
   try
-    Connection.Hostname:=Host;
-    Connection.DatabaseName:=DatabaseName;
-    Connection.Username:=User;
-    Connection.Password:=Password;
-    Connection.Connected:=true;
-    Connection.Transaction:=TSQLTransaction.Create(Connection);
-    if (Port<>'') then
-      Connection.Params.Values['Port']:=Port;
+    FConnection.Hostname:=FHost;
+    FConnection.DatabaseName:=FDatabaseName;
+    FConnection.Username:=FUser;
+    FConnection.Password:=FPassword;
+    FConnection.Connected:=true;
+    FConnection.Transaction:=TSQLTransaction.Create(FConnection);
+    if (FPort<>'') then
+      FConnection.Params.Values['Port']:=FPort;
   except
     On E : Exception do
       begin
       Verbose(V_ERROR,'Failed to connect to database : '+E.Message);
-      FreeAndNil(Connection);
+      FreeAndNil(FConnection);
       end;
   end;
 end;
 
-Procedure DisconnectDatabase;
+procedure TTestSQL.DisconnectDatabase;
 
 begin
-  FreeAndNil(Connection);
+  FreeAndNil(FConnection);
 end;
 
-Function CreateQuery(Const ASQL : String) : TSQLQuery;
+function TTestSQL.CreateQuery(const ASQL: String): TSQLQuery;
 
 begin
-  Result:=TSQLQuery.Create(Connection);
-  Result.Database:=Connection;
-  Result.Transaction:=Connection.Transaction;
+  Result:=TSQLQuery.Create(FConnection);
+  Result.Database:=FConnection;
+  Result.Transaction:=FConnection.Transaction;
   Result.SQL.Text:=ASQL;
 end;
 
 
 
-Function ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
+function TTestSQL.ExecuteQuery(Qry: String; Silent: Boolean): Boolean;
 
 begin
   Verbose(V_SQL,'Executing query:'+Qry);
@@ -121,14 +136,14 @@ begin
   except
     On E : exception do
       begin
-      Connection.Transaction.RollBack;
+      FConnection.Transaction.RollBack;
       if not Silent then
         Verbose(V_WARNING,'Query : '+Qry+'Failed : '+E.Message);
       end;
   end;
 end;
 
-Function OpenQuery (Qry : String; Out res : TSQLQuery; Silent : Boolean) : Boolean ;
+function TTestSQL.OpenQuery(Qry: String; out Res: TSQLQuery; Silent: Boolean): Boolean;
 
 begin
   Result:=False;
@@ -142,7 +157,7 @@ begin
       begin
       FreeAndNil(Res);
       Try
-        Connection.Transaction.RollBack;
+        FConnection.Transaction.RollBack;
       except
       end;
       if not Silent then
@@ -151,9 +166,27 @@ begin
   end;
 end;
 
-Function GetResultField (Res : TSQLQuery; Id : Integer) : String;
+class function TTestSQL.GetIntResultField(Res: TSQLQuery; Id: Integer): Integer;
+
+
+begin
+  If (Res=Nil) or (ID>=Res.Fields.Count) then
+    Result:=-1
+  else
+    Result:=Res.Fields[ID].AsInteger;
+  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
+    Result:=-1
+  else
+    Result:=Res.Fields[ID].AsLargeInt;
+  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
     Result:=''
@@ -162,7 +195,7 @@ begin
   Verbose(V_SQL,'Field value '+Result);
 end;
 
-Procedure FreeQueryResult(var Res : TSQLQuery);
+class procedure TTestSQL.FreeQueryResult(var Res: TSQLQuery);
 
 begin
   if Assigned(Res) and Assigned(Res.Transaction) then
@@ -170,7 +203,7 @@ begin
   FreeAndNil(Res);
 end;
 
-Function IDQuery(Qry : String) : Integer;
+function TTestSQL.IDQuery(Qry: String): Integer;
 
 Var
   Res : TSQLQuery;
@@ -179,13 +212,27 @@ begin
   Result:=-1;
   If OpenQuery(Qry,Res,False) then
     try
-      Result:=StrToIntDef(GetResultField(Res,0),-1);
+      Result:=GetIntResultField(Res,0);
     finally
       FreeQueryResult(Res);
     end;
 end;
 
-Function StringQuery(Qry : String) : String;
+function TTestSQL.ID64Query(Qry: String): Int64;
+Var
+  Res : TSQLQuery;
+
+begin
+  Result:=-1;
+  If OpenQuery(Qry,Res,False) then
+    try
+      Result:=GetInt64ResultField(Res,0);
+    finally
+      FreeQueryResult(Res);
+    end;
+end;
+
+function TTestSQL.StringQuery(Qry: String): String;
 
 Var
   Res : TSQLQuery;
@@ -194,12 +241,17 @@ begin
   Result:='';
   If OpenQuery(Qry,Res,False) then
     try
-      Result:=GetResultField(Res,0);
+      Result:=GetStrResultField(Res,0);
     finally
       FreeQueryResult(Res);
     end;
 end;
 
+constructor TTestSQL.create(aDatabaseName, aHost, aUser, aPassword, aPort: String);
+begin
+
+end;
+
 Function EscapeSQL( S : String) : String;
 
 begin
@@ -220,7 +272,7 @@ end;
   ---------------------------------------------------------------------}
 
 
-Function GetTestID(Name : string) : Integer;
+function TTestSQL.GetTestID(Name: string): Integer;
 
 Const
   SFromName = 'SELECT T_ID FROM TESTS WHERE (T_NAME=''%s'')';
@@ -229,7 +281,7 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-Function GetOSID(Name : String) : Integer;
+function TTestSQL.GetOSID(Name: String): Integer;
 
 Const
   SFromName = 'SELECT TO_ID FROM TESTOS WHERE (TO_NAME=''%s'')';
@@ -238,7 +290,7 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-Function GetVersionID(Name : String) : Integer;
+function TTestSQL.GetVersionID(Name: String): Integer;
 
 Const
   SFromName = 'SELECT TV_ID FROM TESTVERSION WHERE (TV_VERSION=''%s'')';
@@ -247,7 +299,7 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-Function GetCPUID(Name : String) : Integer;
+function TTestSQL.GetCPUID(Name: String): Integer;
 
 Const
   SFromName = 'SELECT TC_ID FROM TESTCPU WHERE (TC_NAME=''%s'')';
@@ -256,7 +308,7 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-Function GetCategoryID(Name : String) : Integer;
+function TTestSQL.GetCategoryID(Name: String): Integer;
 
 Const
   SFromName = 'SELECT TCAT_ID FROM TESTCATEGORY WHERE (TCAT_NAME=''%s'')';
@@ -265,7 +317,7 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-Function GetRunID(OSID, CPUID, VERSIONID : Integer; Date : TDateTime) : Integer;
+function TTestSQL.GetRunID(OSID, CPUID, VERSIONID: Integer; Date: TDateTime): Integer;
 
 
 Const
@@ -279,13 +331,13 @@ begin
   Result:=IDQuery(Format(SFromIDS,[OSID,CPUID,VERSIONID,SQLDate(Date)]));
 end;
 
-Function InsertQuery(const Query : string) : Integer;
+function TTestSQL.InsertQuery(const Query: string): Integer;
 
 begin
   Result:=IDQuery(Query);
 end;
 
-Function AddRun(OSID, CPUID, VERSIONID, CATEGORYID : Integer; Date : TDateTime) : Integer;
+function TTestSQL.AddRun(OSID, CPUID, VERSIONID, CATEGORYID: Integer; Date: TDateTime): Integer;
 
 Const
   SInsertRun = 'INSERT INTO TESTRUN '+
@@ -308,11 +360,11 @@ begin
   Result := i;
 end;
 
-function GetUnitTestConfig(const fn : string; var r : TConfig) : Boolean;
+function TTestSQL.GetUnitTestConfig(const fn : string; var r : TConfig) : Boolean;
 var
   Path       : string;
-  ClassName  : string;
-  MethodName : string;
+  lClassName  : string;
+  lMethodName : string;
   slashpos   : integer;
   FileName   : string;
   s          : string;
@@ -323,21 +375,21 @@ begin
   if pos('.',fn) > 0 then exit; // This is normally not a unit-test
   slashpos := posr('/',fn);
   if slashpos < 1 then exit;
-  MethodName := copy(fn,slashpos+1,length(fn));
+  lMethodName := copy(fn,slashpos+1,length(fn));
   Path := copy(fn,1,slashpos-1);
   slashpos := posr('/',Path);
   if slashpos > 0 then
     begin
-    ClassName := copy(Path,slashpos+1,length(Path));
+    lClassName := copy(Path,slashpos+1,length(Path));
     Path := copy(Path,1,slashpos-1);
     end
   else
     begin
-    ClassName := Path;
+    lClassName := Path;
     path := '.';
     end;
-  if upper(ClassName[1])<>'T' then exit;
-  FileName := TestSrcDir+RelSrcDir+Path+DirectorySeparator+copy(lowercase(ClassName),2,length(classname));
+  if upper(lClassName[1])<>'T' then exit;
+  FileName := TestSrcDir+RelSrcDir+Path+DirectorySeparator+copy(lowercase(lClassName),2,length(lClassName));
   if FileExists(FileName+'.pas') then
     FileName := FileName + '.pas'
   else if FileExists(FileName+'.pp') then
@@ -367,7 +419,7 @@ begin
             begin
               s := copy(s,11,pos(';',s)-11);
               TrimB(s);
-              if SameText(s,ClassName+'.'+MethodName) then
+              if SameText(s,lClassName+'.'+lMethodName) then
                begin
                  Result := True;
                  r.Note:= 'unittest';
@@ -379,7 +431,7 @@ begin
   close(t);
 end;
 
-Function AddTest(Name : String; AddSource : Boolean) : Integer;
+function TTestSQL.AddTest(Name: String; AddSource: Boolean): Integer;
 
 Const
   SInsertTest = 'INSERT INTO TESTS (T_NAME,T_ADDDATE)'+
@@ -413,7 +465,7 @@ end;
 Const
   B : Array[Boolean] of String = ('f','t');
 
-Function UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
+function TTestSQL.UpdateTest(ID: Integer; Info: TConfig; Source: String): Boolean;
 
 Const
   SUpdateTest = 'Update TESTS SET '+
@@ -448,9 +500,7 @@ begin
   Result:=ExecuteQuery(Qry,False);
 end;
 
-Function AddTestResult(TestID,RunID,TestRes : Integer;
-                       OK, Skipped : Boolean;
-                       Log : String;var count_it : boolean) : Integer;
+function TTestSQL.AddTestResult(TestID, RunID, TestRes: Integer; OK, Skipped: Boolean; Log: String; var count_it: boolean): Int64;
 
 Const
   SInsertRes='Insert into TESTRESULTS '+
@@ -495,7 +545,7 @@ begin
   count_it:=not updateValues or (prevTestResult<>TestRes);
 end;
 
-Function RequireTestID(Name : String): Integer;
+function TTestSQL.RequireTestID(Name: String): Integer;
 
 begin
   Result:=GetTestID(Name);
@@ -505,7 +555,7 @@ begin
     Verbose(V_WARNING,'Could not find or create entry for test '+Name);
 end;
 
-Function CleanTestRun(ID : Integer) : Boolean;
+function TTestSQL.CleanTestRun(ID: Integer): Boolean;
 
 Const
   SDeleteRun = 'DELETE FROM TESTRESULTS WHERE TR_TESTRUN_FK=%d';
@@ -514,27 +564,14 @@ begin
   Result:=ExecuteQuery(Format(SDeleteRun,[ID]),False);
 end;
 
-function GetTestPreviousRunHistoryID(TestRunID : Integer) : Integer;
+class function TTestSQL.EscapeSQL(S: String): String;
 begin
-  GetTestPreviousRunHistoryID:=IDQuery(
-    format('SELECT TH_PREVIOUS_FK FROM TESTRUNHISTORY WHERE TH_ID_FK=%d',[TestRunID]));
-end;
 
-function GetTestNextRunHistoryID(TestRunID : Integer) : Integer;
-begin
-  GetTestNextRunHistoryID:=IDQuery(
-    format('SELECT TH_ID_FK FROM TESTRUNHISTORY WHERE TH_PREVIOUS_FK=%d',[TestRunID]));
 end;
 
-function AddTestHistoryEntry(TestRunID,TestPreviousID : Integer) : boolean;
-
-var
-  qry : string;
-
+class function TTestSQL.SQLDate(D: TDateTime): String;
 begin
-  Qry:=format('INSERT INTO TESTRUNHISTORY (TH_ID_FK,TH_PREVIOUS_FK) '+
-              ' VALUES (%d,%d)',[TestRunID,TestPreviousID]);
-  Result:=ExecuteQuery(Qry,False);
+
 end;
 
 end.

tests/utils/digestanalyst.pas

@@ -0,0 +1,431 @@
+unit digestanalyst;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, teststr, testu, tresults, dbtests;
+
+Type
+  TDigestConfig = record
+    databasename: string;
+    host: string;
+    username: string;
+    password: string;
+    port: string;
+    logfile: string;
+    longlogfile : string;
+    os: string;
+    cpu: string;
+    category: string;
+    version: string;
+    date: string;
+    submitter: string;
+    machine: string;
+    config : string;
+    description : string;
+    testsrcdir: string;
+    relsrcdir: string;
+    verbose: string;
+    sql: string;
+  end;
+
+  TTestRunData = Record
+    Date : TDateTime;
+    CompilerDate,
+    CompilerFullVersion,
+    SvnCompilerRevision,
+    SvnTestsRevision,
+    SvnRTLRevision,
+    SvnPackagesRevision : String;
+    CPUID : Integer;
+    OSID  : Integer;
+    VersionID  : Integer;
+    CategoryID : Integer;
+    RunID : Integer;
+    ConfigID : Integer;
+  end;
+
+  { TDBDigestAnalyzer }
+
+  TDBDigestAnalyzer = Class(TObject)
+    FDB : TTestDB;
+    LongLogFile : TStrings;
+    StatusCount : Array[TTestStatus] of Integer;
+    UnknownLines : integer;
+    UseLongLog : Boolean;
+    FCurLongLogLine : Integer;
+    constructor Create(aDB : TTestDB);
+    function CheckIDs(aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+    function GetExecuteLog(Line, FN: String): String;
+    function GetIDs(const aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+    procedure Processfile(const aFileName: String; const aData: TTestRunData);
+    procedure UpdateTestRun(const aData: TTestRunData);
+    procedure UpdateTestRunBefore(const aConfig: TDigestConfig; const aData: TTestRunData);
+    procedure Analyse(aConfig : TDigestConfig);
+  private
+    function GetContentsFromLongLog(Line: String): String;
+    function GetLog(Line, FN: String): String;
+  end;
+
+
+implementation
+
+constructor TDBDigestAnalyzer.Create(aDB: TTestDB);
+begin
+  FDB:=aDB;
+end;
+
+function TDBDigestAnalyzer.CheckIDs(aConfig : TDigestConfig; var aData : TTestRunData): Boolean;
+
+begin
+  If aData.CategoryID=-1 then
+    aData.CategoryID:=1;
+  // Checks
+  If aData.CPUID=-1 then
+    Verbose(V_Error,'NO ID for CPU "'+aConfig.CPU+'" found.');
+  If aData.OSID=-1 then
+    Verbose(V_Error,'NO ID for OS "'+aConfig.OS+'" found.');
+  If aData.VersionID=-1 then
+    Verbose(V_Error,'NO ID for version "'+aConfig.Version+'" found.');
+end;
+
+
+procedure TDBDigestAnalyzer.UpdateTestRunBefore(const aConfig : TDigestConfig; const aData : TTestRunData);
+
+var
+  qry : string;
+
+begin
+  { Add known infomration at start }
+  qry:=format('UPDATE TESTRUN SET TU_SUBMITTER=''%s'', TU_MACHINE=''%s'', TU_COMMENT=''%s'', TU_DATE=''%s''',[aConfig.Submitter,aConfig.Machine,aConfig.Comment,TTestDB.SqlDate(aData.Date)]);
+  qry:=qry+' WHERE TU_ID='+format('%d',[aData.RunID]);
+  FDB.ExecuteQuery(Qry,False);
+end;
+
+procedure TDBDigestAnalyzer.Analyse(aConfig: TDigestConfig);
+
+var
+  lData : TTestRunData;
+
+begin
+  lData:=Default(TTestRunData);
+  if (aConfig.longlogfile<>'') and FileExists(aConfig.longlogfile) then
+    begin
+    LongLogFile:=TStringList.Create;
+    LongLogFile.LoadFromFile(aConfig.longlogfile);
+    end;
+  if not GetIDS(aConfig,lData) then
+    exit;
+  UpdateTestRunBefore(aConfig,lData);
+  ProcessFile(aConfig.logfile,lData);
+  UpdateTestRun(lData);
+end;
+
+function TDBDigestAnalyzer.GetIDs(const aConfig : TDigestConfig; var aData : TTestRunData): Boolean;
+
+
+begin
+  Result:=False;
+  aData:=Default(TTestRunData);
+  aData.CPUID := FDB.GetCPUID(aConfig.CPU);
+  aData.OSID  := FDB.GetOSID(aConfig.OS);
+  aData.VersionID  := FDB.GetVersionID(aConfig.Version);
+  aData.CategoryID := FDB.GetCategoryID(aConfig.Category);
+  aData.PlatformID := FDB.GetCategoryID(aConfig.Category);
+  If (Round(aData.Date)=0) then
+    aData.Date:=Now;
+  Result:=CheckIDS(aConfig,aData);
+  if not Result then
+    Exit;
+  aData.RunID:=FDB.GetRunID(aData.OSID,aData.CPUID,aData.VersionID,aData.Date);
+  If (aData.RunID<>-1) then
+    FDB.CleanTestRun(aData.RunID)
+  else
+    begin
+    aData.RunID:=FDB.AddRun(aData.OSID,aData.CPUID,aData.VersionID,aData.CategoryID,aData.Date);
+    Result:=aData.RunID<>-1;
+    if not Result then
+      begin
+      Verbose(V_Error,'Could not insert new testrun record!');
+      exit;
+      end;
+    end;
+end;
+
+Procedure ExtractTestFileName(Var Line : string);
+
+Var I : integer;
+
+begin
+  I:=Pos(' ',Line);
+  If (I<>0) then
+    Line:=Copy(Line,1,I-1);
+end;
+
+Function AnalyseLine(Var Line : string; Var Status : TTestStatus) : Boolean;
+
+Var
+  TS : TTestStatus;
+
+begin
+  Result:=False;
+  For TS:=FirstStatus to LastStatus do
+    begin
+    Result:=Pos(StatusText[TS],Line)=1;
+    If Result then
+      begin
+      Status:=TS;
+      Delete(Line,1,Length(StatusText[TS]));
+      ExtractTestFileName(Line);
+      Break;
+      end;
+    end;
+end;
+
+(*
+
+ConfigAddStrings : Array [TConfigAddOpt] of string = (
+  'compilerdate',
+  'compilerfullversion',
+  'svncompilerrevision',
+  'svntestsrevision',
+  'svnrtlrevision',
+  'svnpackagesrevision'
+ );
+
+ConfigAddCols : Array [TConfigAddOpt] of string = (
+  'TU_COMPILERDATE',
+  'TU_COMPILERFULLVERSION',
+  'TU_SVNCOMPILERREVISION',
+  'TU_SVNTESTSREVISION',
+  'TU_SVNRTLREVISION',
+  'TU_SVNPACKAGESREVISION'
+ );
+
+*)
+
+
+
+const
+   SeparationLine = '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>';
+
+Function TDBDigestAnalyzer.GetContentsFromLongLog(Line : String) : String;
+
+  Function GetLongLogLine : String;
+  begin
+    Result:=LongLogFile[FCurLongLogLine];
+    Inc(FCurLongLogLine);
+  end;
+
+  Function HaveLongLogLine : Boolean; inline;
+  begin
+    Result:=FCurLongLogLine<LongLogFile.Count;
+  end;
+
+var
+  S : String;
+  IsFirst, IsFound : boolean;
+
+begin
+  Result:='';
+  IsFirst:=true;
+  IsFound:=false;
+  While HaveLongLogLine do
+    begin
+      S:=GetLongLogLine;
+      if FCurLongLogLine=1 then
+        begin
+          { At start of file there is a separation line }
+          if (pos(Line,S)=0) and (pos(SeparationLine,S)>=1) then
+            S:=GetLongLogLine
+        end;
+      if pos(Line,S)=1 then
+        begin
+          IsFound:=true;
+          while HaveLongLogLine do
+            begin
+              S:=GetLongLogLine;
+              { End of file marker }
+              if (Not HaveLongLogLine) or (pos(SeparationLine,S)=1) then
+                exit;
+              if length(Result)<MaxLogSize then
+                Result:=Result+S+LineEnding;
+              if pos(SeparationLine,S)>1 then
+                exit;
+            end;
+        end
+      else if IsFirst then
+        begin
+          Verbose(V_Warning,'Line "'+Line+'" not found as next "'+S+'"');
+          IsFirst:=false;
+        end;
+    end;
+  if not IsFound then
+    begin
+    Verbose(V_Warning,'Line "'+Line+'" not found');
+    FCurlongLogLine:=0; // Reset
+    end;
+end;
+
+Function TDBDigestAnalyzer.GetLog(Line, FN : String) : String;
+
+begin
+  if UseLongLog then
+    begin
+      Result:=GetContentsFromLongLog(Line);
+      exit;
+    end;
+  FN:=ChangeFileExt(FN,'.log');
+  { packages tests have ../ replaced by root/ }
+  if not FileExists(FN) and (Copy(FN,1,3)='../') then
+    FN:='root/'+Copy(FN,4,length(FN));
+  If FileExists(FN) then
+    Result:=GetFileContents(FN)
+  else
+    begin
+      Verbose(V_Warning,'File "'+FN+'" not found');
+      Result:='';
+    end;
+end;
+
+function TDBDigestAnalyzer.GetExecuteLog(Line, FN: String): String;
+
+begin
+  if UseLongLog then
+    begin
+      Result:=GetContentsFromLongLog(Line);
+      exit;
+    end;
+  FN:=ChangeFileExt(FN,'.elg');
+  { packages tests have ../ replaced by root/ }
+  if not FileExists(FN) and (Copy(FN,1,3)='../') then
+    FN:='root/'+Copy(FN,4,length(FN));
+  If FileExists(FN) then
+    Result:=GetFileContents(FN)
+  else
+    begin
+      Verbose(V_Warning,'File "'+FN+'" not found');
+      Result:='';
+    end;
+end;
+
+procedure TDBDigestAnalyzer.Processfile(const aFileName: String; const aData: TTestRunData);
+
+var
+  logfile : text;
+  fullline,line,prevLine : string;
+  TS,PrevTS : TTestStatus;
+  ID,PrevID : integer;
+  Testlog : string;
+  count_test : boolean;
+begin
+  AssignFile(logfile,aFileName);
+  PrevId:=-1;
+  PrevLine:='';
+  count_test:=false;
+  PrevTS:=low(TTestStatus);
+{$i-}
+  reset(logfile);
+  if ioresult<>0 then
+    begin
+    Verbose(V_Error,'Unable to open log file'+aFileName);
+    exit;
+    end;
+{$i+}
+  while not eof(logfile) do
+    begin
+    readln(logfile,line);
+    fullline:=line;
+    ts:=stFailedToCompile;
+    If AnalyseLine(line,TS) then
+      begin
+      Verbose(V_NORMAL,'Analysing result for test '+Line);
+      If Not ExpectRun[TS] then
+        begin
+        ID:=FDB.RequireTestID(Line);
+        if (PrevID<>-1) and (PrevID<>ID) then
+          begin
+            { This can only happen if a Successfully compiled message
+              is not followed by any other line about the same test }
+            TestLog:='';
+            FDB.AddTestResult(PrevID,aData.RunId,ord(PrevTS),
+              TestOK[PrevTS],TestSkipped[PrevTS],TestLog,count_test);
+            Verbose(V_Warning,'Orphaned test: "'+prevline+'"');
+          end;
+        PrevID:=-1;
+        If (ID<>-1) then
+          begin
+          If Not (TestOK[TS] or TestSkipped[TS]) then
+            begin
+              TestLog:=GetExecuteLog(Fullline,Line);
+              if pos(failed_to_compile,TestLog)=1 then
+                TestLog:=GetLog(Fullline,Line);
+            end
+          else
+            TestLog:='';
+          { AddTestResult can fail for test that contain %recompile
+            as the same }
+          if FDB.AddTestResult(ID,aData.RunID,Ord(TS),TestOK[TS],
+               TestSkipped[TS],TestLog,count_test) <> -1 then
+            begin
+              if count_test then
+                Inc(StatusCount[TS])
+              else
+                Verbose(V_Debug,'Test: "'+line+'" was updated');
+            end
+          else
+            begin
+              Verbose(V_Warning,'Test: "'+line+'" already registered');
+            end;
+
+          end;
+        end
+      else
+        begin
+          Inc(StatusCount[TS]);
+          PrevTS:=TS;
+          PrevID:=FDB.RequireTestID(line);
+          PrevLine:=line;
+        end;
+
+      end
+    else
+      begin
+        Inc(UnknownLines);
+        Verbose(V_Warning,'Unknown line: "'+line+'"');
+      end;
+    end;
+  close(logfile);
+end;
+
+procedure TDBDigestAnalyzer.UpdateTestRun(const aData : TTestRunData);
+
+var
+   i : TTestStatus;
+   qry : string;
+
+begin
+  qry:='UPDATE TESTRUN SET ';
+  for i:=low(TTestStatus) to high(TTestStatus) do
+    qry:=qry+format('%s=%d, ',[SQLField[i],StatusCount[i]]);
+  if aData.CompilerDate<>'' then
+    qry:=qry+format('%s=''%s'', ',['TU_COMPILERDATE',TTestDB.EscapeSQL(aData.CompilerDate)]);
+  if aData.CompilerFullVersion<>'' then
+    qry:=qry+format('%s=''%s'', ',['TU_COMPILERFULLVERSION',TTestDB.EscapeSQL(aData.CompilerFullVersion)]);
+  if aData.SvnCompilerRevision<>'' then
+    qry:=qry+format('%s=''%s'', ',['TU_SVNCOMPILERREVISION',TTestDB.EscapeSQL(aData.SvnCompilerRevision)]);
+  if aData.SvnTestsRevision<>'' then
+    qry:=qry+format('%s=''%s'', ',['TU_SVNTESTSREVISION',TTestDB.EscapeSQL(aData.SvnTestsRevision)]);
+  if aData.SvnRTLRevision<>'' then
+    qry:=qry+format('%s=''%s'', ',['TU_SVNRTLREVISION',TTestDB.EscapeSQL(aData.SvnRTLRevision)]);
+  if aData.SvnPackagesRevision<>'' then
+    qry:=qry+format('%s=''%s'', ',['TU_SVNPACKAGESREVISION',TTestDB.EscapeSQL(aData.SvnPackagesRevision)]);
+  qry:=qry+' WHERE TU_ID='+format('%d',[aData.RunID]);
+  FDB.ExecuteQuery(Qry,False);
+end;
+
+
+end.
+

tests/utils/testsuite.sql

@@ -0,0 +1,124 @@
+-- Database: testsuite
+
+-- DROP DATABASE IF EXISTS testsuite;
+
+CREATE DATABASE testsuite
+    WITH
+    OWNER = fpc
+    ENCODING = 'UTF8'
+    LC_COLLATE = 'en_GB.UTF-8'
+    LC_CTYPE = 'en_GB.UTF-8'
+    TABLESPACE = pg_default
+    CONNECTION LIMIT = -1
+    IS_TEMPLATE = False;
+
+CREATE SEQUENCE SEQ_TESTCATEGORY;
+
+CREATE TABLE TESTCATEGORY (
+  TA_ID INT NOT NULL DEFAULT nextval('SEQ_TESTCATEGORY'),
+  TA_NAME VARCHAR(20),
+  constraint PK_TESTCATEGORY PRIMARY KEY (TA_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTCATEGORYNAME ON TESTCATEGORY(TA_NAME);
+
+CREATE SEQUENCE SEQ_TESTCPU;
+
+CREATE TABLE TESTCPU (
+  TC_ID INT NOT NULL DEFAULT nextval('SEQ_TESTCPU'),
+  TC_NAME varchar(10),
+  constraint PK_TESTCPU PRIMARY KEY (TC_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTCPU ON TESTCPU(TC_NAME);
+
+CREATE SEQUENCE SEQ_TESTOS;
+
+CREATE TABLE TESTOS (
+  TO_ID INT DEFAULT nextval('SEQ_TESTOS'),
+  TO_NAME varchar(10),
+  constraint PK_TESTOS PRIMARY KEY (TO_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTOS ON TESTOS(TO_NAME);
+
+CREATE SEQUENCE SEQ_TESTVERSION;
+
+CREATE TABLE TESTVERSION (
+  TV_ID int NOT NULL default nextval('SEQ_TESTVERSION'),
+  TV_VERSION varchar(10),
+  TV_RELEASEDATE date DEFAULT CURRENT_TIMESTAMP,
+  constraint PK_TESTVERSION PRIMARY KEY (TV_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTVERSION ON TESTVERSION(TV_VERSION);
+
+CREATE SEQUENCE SEQ_TESTS;
+
+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_VERSION varchar(10),
+  T_ADDDATE date NOT NULL,
+  T_GRAPH boolean NOT NULL default 'f',
+  T_INTERACTIVE boolean NOT NULL default 'f',
+  T_RESULT int NOT NULL default '0',
+  T_FAIL boolean NOT NULL default 'f',
+  T_RECOMPILE boolean NOT NULL default 'f',
+  T_NORUN boolean NOT NULL default 'f',
+  T_NEEDLIBRARY boolean NOT NULL default 'f',
+  T_KNOWNRUNERROR INT NOT NULL default 0,
+  T_KNOWN boolean NOT NULL default 'f',
+  T_NOTE varchar(255) default NULL,
+  T_DESCRIPTION text,
+  T_SOURCE text,
+  T_OPTS varchar(255) default NULL,
+  constraint PK_TESTS PRIMARY KEY  (T_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTS ON TESTS(T_NAME);
+
+CREATE SEQUENCE SEQ_TESTPLATFORM;
+
+CREATE TABLE TESTPLATFORM (
+  TP_ID INT NOT NULL default nextval('SEQ_TESTPLATFORM'),
+  TP_CPU_FK INT NOT NULL,
+  TP_OS_FK INT NOT NULL,
+  TP_VERSION_FK INT NOT NULL,
+  TP_CATEGORY_FK int NOT NULL,
+  TP_CONFIG VARCHAR(255) NOT NULL,
+  TP_MACHINE VARCHAR(127) NOT NULL,
+  constraint PK_TESTPLATFORM PRIMARY KEY (TP_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTPLATFORM ON TESTPLATFORM(TP_CPU_FK,TP_OS_FK,TP_VERSION_FK,TP_CATEGORY_FK,TP_CONFIG,TP_MACHINE);
+CREATE INDEX IDX_TESTPLATFORMRELATIONS ON TESTPLATFORM(TP_CPU_FK,TP_OS_FK,TP_VERSION_FK,TP_CATEGORY_FK);
+
+CREATE SEQUENCE SEQ_TESTRUN;
+
+CREATE TABLE TESTRUN (
+  TU_ID bigint NOT NULL default nextval('SEQ_TESTRUN'),
+  TU_DATE DATE NOT NULL default CURRENT_DATE,
+  TU_PLATFORM_FK int NOT NULL,
+  TU_FAILEDTOCOMPILE int NOT NULL default 0,
+  TU_SUCCESSFULLYFAILED int NOT NULL default 0,
+  TU_FAILEDTOFAIL int NOT NULL default 0,
+  TU_SUCCESFULLYCOMPILED int NOT NULL default 0,
+  TU_FAILEDTORUN int NOT NULL default 0,
+  TU_KNOWNPROBLEM int NOT NULL default 0,
+  TU_SUCCESSFULLYRUN int NOT NULL default 0,
+  TU_SKIPPEDGRAPHTEST int NOT NULL default 0,
+  TU_SKIPPEDINTERACTIVETEST int NOT NULL default 0,
+  TU_KNOWNBUG int NOT NULL default 0,
+  TU_COMPILERVERIONTOOLOW int NOT NULL default 0,
+  TU_COMPILERVERIONTOOHIGH int NOT NULL default 0,
+  TU_OTHERCPU int NOT NULL default 0,
+  TU_OTHERTARGET int NOT NULL default 0,
+  TU_UNIT int NOT NULL default 0,
+  TU_SKIPPINGRUNTEST int NOT NULL default 0,
+  TU_SUBMITTER varchar(128) NOT NULL default '',
+  CONSTRAINT PK_TESTRUN PRIMARY KEY (TU_ID)
+);
+