* First working version

tests/utils/dbdigest.lpi

@@ -6,7 +6,6 @@
       <Flags>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
-        <UseDefaultCompilerOptions Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <Title Value="FPC Digest Application"/>
@@ -42,6 +41,11 @@
     <SearchPaths>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
   </CompilerOptions>
   <Debugging>
     <Exceptions>

tests/utils/dbdigest.pp

@@ -23,783 +23,352 @@
 program dbdigest;
 
 uses
-  sysutils,teststr,testu,tresults,dbtests;
-
-
-Var
-  StatusCount : Array[TTestStatus] of Integer;
-  UnknownLines : integer;
-
-
-Procedure ExtractTestFileName(Var Line : string);
-
-Var I : integer;
-
-begin
-  I:=Pos(' ',Line);
-  If (I<>0) then
-    Line:=Copy(Line,1,I-1);
-end;
-
-Function Analyse(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;
+  types, classes, custapp, sysutils, inifiles, teststr, testu, tresults, dbtests, digestanalyst;
 
 Type
 
-TConfigOpt = (
-  coDatabaseName,
-  coHost,
-  coUserName,
-  coPassword,
-  coPort,
-  coLogFile,
-  coLongLogFile,
-  coOS,
-  coCPU,
-  coCategory,
-  coVersion,
-  coDate,
-  coSubmitter,
-  coMachine,
-  coComment,
-  coTestSrcDir,
-  coRelSrcDir,
-  coVerbose,
-  coSQL
- );
-
-{ Additional options only for dbdigest.cfg file }
-
-TConfigAddOpt = (
-  coCompilerDate,
-  coCompilerFullVersion,
-  coSvnCompilerRevision,
-  coSvnTestsRevision,
-  coSvnRTLRevision,
-  coSvnPackagesRevision
- );
-
-Const
-
-ConfigStrings : Array [TConfigOpt] of string = (
-  'databasename',
-  'host',
-  'username',
-  'password',
-  'port',
-  'logfile',
-  'longlogfile',
-  'os',
-  'cpu',
-  'category',
-  'version',
-  'date',
-  'submitter',
-  'machine',
-  'comment',
-  'testsrcdir',
-  'relsrcdir',
-  'verbose',
-  'sql'
-);
-
-ConfigOpts : Array[TConfigOpt] of char =(
- '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 }
-);
-
-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'
- );
-
-
-Var
-  TestOS,
-  TestCPU,
-  TestVersion,
-  TestCategory,
-  DatabaseName,
-  HostName,
-  UserName,
-  Password,
-  Port,
-  LongLogFileName,
-  LogFileName,
-  Submitter,
-  Machine,
-  Comment : String;
-  TestDate : TDateTime;
-  TestCompilerDate,
-  TestCompilerFullVersion,
-  TestSvnCompilerRevision,
-  TestSvnTestsRevision,
-  TestSvnRTLRevision,
-  TestSvnPackagesRevision : String;
-
-Procedure SetAddOpt (O : TConfigAddOpt; Value : string);
-begin
-  Case O of
-    coCompilerDate:
-      TestCompilerDate:=Value;
-    coCompilerFullVersion:
-      TestCompilerFullVersion:=Value;
-    coSvnCompilerRevision:
-      TestSvnCompilerRevision:=Value;
-    coSvnTestsRevision:
-      TestSvnTestsRevision:=Value;
-    coSvnRTLRevision:
-      TestSvnRTLRevision:=Value;
-    coSvnPackagesRevision:
-      TestSvnPackagesRevision:=Value;
+  { 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 }
+     ;
+
+    LongOpts : Array of string = (
+      'databasename',
+      'host',
+      'username',
+      'password',
+      'port',
+      'logfile',
+      'longlogfile',
+      'os',
+      'cpu',
+      'category',
+      'version',
+      'date',
+      'submitter',
+      'machine',
+      'comment',
+      'testsrcdir',
+      'relsrcdir',
+      'verbose',
+      'sql',
+      'compilerdate',
+      'compilerfullversion',
+      'svncompilerrevision',
+      'svntestsrevision',
+      'svnrtlrevision',
+      'svnpackagesrevision'
+    );
+    // Return true if we can continue
+    function ProcessCommandLine(var aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+  private
+    class function ExtractDate(aValue: string): TDateTime;
+    procedure Analyze(const aConfig: TDigestConfig; const aData: TTestRunData);
+    procedure ProcessConfigfile(const aFileName: String; var aConfig: TDigestConfig; var aData: TTestRunData);
+    function ProcessOption(const aOption: String; aValue: String; var aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+    procedure ReadSystemDBConfig(var aConfig: TDigestConfig);
+  protected
+    procedure DoRun; override;
+    procedure Usage(const aMsg: String);
   end;
-end;
 
-Procedure SetOpt (O : TConfigOpt; Value : string);
+class Function TDBDigestApplication.ExtractDate(aValue : string) : TDateTime;
+
 var
   year,month,day,min,hour : word;
+
 begin
-  Case O of
-    coDatabaseName : DatabaseName:=Value;
-    coHost         : HostName:=Value;
-    coUserName     : UserName:=Value;
-    coPassword     : Password:=Value;
-    coPort         : Port:=Value;
-    coLogFile      : LogFileName:=Value;
-    coLongLogFile  : LongLogFileName:=Value;
-    coOS           : TestOS:=Value;
-    coCPU          : TestCPU:=Value;
-    coCategory     : TestCategory:=Value;
-    coVersion      : TestVersion:=Value;
-    coSQL          : DoSQL:=True;
-    coDate         :
-      begin
-        { Formated like YYYYMMDDhhmm }
-	if Length(value)=12 then
-	  begin
-	    year:=StrToInt(Copy(value,1,4));
-	    month:=StrToInt(Copy(value,5,2));
-	    day:=StrToInt(Copy(Value,7,2));
-	    hour:=StrToInt(Copy(Value,9,2));
-	    min:=StrToInt(Copy(Value,11,2));
-	    TestDate:=EncodeDate(year,month,day)+EncodeTime(hour,min,0,0);
-	  end
-	else
-	  Verbose(V_Error,'Error in date format, use YYYYMMDDhhmm');
-      end;
-    coSubmitter    : Submitter:=Value;
-    coMachine      : Machine:=Value;
-    coComment      : Comment:=Value;
-    coVerbose      : DoVerbose:=true;
-    coTestSrcDir   :
-      begin
-        TestSrcDir:=Value;
-	if (TestSrcDir<>'') and (TestSrcDir[length(TestSrcDir)]<>'/') then
-	  TestSrcDir:=TestSrcDir+'/';
-      end;
-    coRelSrcDir   :
-      begin
-        RelSrcDir:=Value;
-	if (RelSrcDir<>'') and (RelSrcDir[length(RelSrcDir)]<>'/') then
-	  RelSrcDir:=RelSrcDir+'/';
-	if (RelSrcDir<>'') and (RelSrcDir[1]='/') then
-	  RelSrcDir:=copy(RelSrcDir,2,length(RelSrcDir)-1);
-      end;
-  end;
+  if Length(avalue)=12 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));
+      Result:=EncodeDate(year,month,day)+EncodeTime(hour,min,0,0);
+    end
+  else
+    Verbose(V_Error,'Error in date format, use YYYYMMDDhhmm');
 end;
 
-Function ProcessOption(S: String) : Boolean;
-
-Var
-  N : String;
-  I : Integer;
-  co : TConfigOpt;
-  coa : TConfigAddOpt;
+Function TDBDigestApplication.ProcessOption(const aOption : String; aValue: String; var aConfig : TDigestConfig; var aData : TTestRunData) : Boolean;
 
 begin
-  Verbose(V_DEBUG,'Processing option: '+S);
-  I:=Pos('=',S);
-  Result:=(I<>0);
-  If Result then
-    begin
-    N:=Copy(S,1,I-1);
-    Delete(S,1,I);
-    For co:=low(TConfigOpt) to high(TConfigOpt) do
-      begin
-      Result:=CompareText(ConfigStrings[co],N)=0;
-      If Result then
-        begin
-          SetOpt(co,S);
-          Exit;
-        end;
-      end;
-    For coa:=low(TConfigAddOpt) to high(TConfigAddOpt) do
-      begin
-      Result:=CompareText(ConfigAddStrings[coa],N)=0;
-      If Result then
-        begin
-          SetAddOpt(coa,S);
-          Exit;
-        end;
-      end;
-    end;
-  Verbose(V_ERROR,'Unknown option : '+n+S);
+  Result:=True;
+  Verbose(V_DEBUG,'Processing option: '+aOption);
+  Case aOption of
+    'd','databasename' : aConfig.databasename:=aValue;
+    'h','host' : aConfig.host:=aValue;
+    'u','username': aConfig.username:=aValue;
+    'p','password': aConfig.password:=aValue;
+    'P','port': aConfig.port:=StrToIntDef(aValue,0);
+    'l','logfile': aData.logfile:=aValue;
+    'L','longlogfile': aData.longlogfile:=aValue;
+    'o','os': aData.os:=aValue;
+    'c','cpu': aData.cpu:=aValue;
+    'a','category': aData.category:=aValue;
+    'v','version': aData.version:=aValue;
+    't','date': aData.date:=ExtractDate(aValue);
+    's','submitter': aData.submitter:=aValue;
+    'm','machine': aData.machine:=aValue;
+    'C','comment': aData.config:=aValue;
+    'D','description': aData.description:=aValue;
+    'S','testsrcdir': aConfig.testsrcdir:=aValue;
+    'r','relsrcdir': aConfig.relsrcdir:=aValue;
+    'V','verbose': DoVerbose:=True;
+    //  'S','sql': aConfig.sql:=aValue;
+    'compilerdate': aData.CompilerDate:=aValue;
+    'compilerfullversion': aData.CompilerFullVersion:=aValue;
+    'svncompilerrevision': aData.CompilerRevision:=aValue;
+    'svntestsrevision': aData.TestsRevision:=aValue;
+    'svnrtlrevision': aData.RTLRevision:=aValue;
+    'svnpackagesrevision' : aData.PackagesRevision:=aValue;
+  else
+    Verbose(V_ERROR,'Unknown processing option: '+aOption);
+  end;
 end;
 
-Procedure ProcessConfigfile(FN : String);
+Procedure TDBDigestApplication.ProcessConfigfile(const aFileName : String; var aConfig : TDigestConfig; var aData : TTestRunData);
 
 Var
-  F : Text;
-  S : String;
+  Cfg : TStrings;
+  aLine,S,N,V : String;
   I : Integer;
 
 begin
   // Set the default value for old digests without RelSrcDir to the rtl/compiler
   // testsuite
-  RelSrcDir:='tests/';
-  If Not FileExists(FN) Then
-    Exit;
-  Verbose(V_DEBUG,'Parsing config file: '+FN);
-  Assign(F,FN);
-  {$i-}
-  Reset(F);
-  If IOResult<>0 then
+  If Not FileExists(aFileName) Then
     Exit;
-  {$I+}
-  While not(EOF(F)) do
-    begin
-    ReadLn(F,S);
-    S:=trim(S);
-    I:=Pos('#',S);
-    If I<>0 then
-      S:=Copy(S,1,I-1);
-    If (S<>'') then
-      ProcessOption(S);
-    end;
-  Close(F);
-end;
-
-Procedure ProcessCommandLine;
-
-Var
-  I : Integer;
-  O : String;
-  c,co : TConfigOpt;
-  ShortOptFound, Found : Boolean;
-
-begin
-  I:=1;
-  While I<=ParamCount do
-    begin
-    O:=Paramstr(I);
-    ShortOptFound:=(Length(O)=2) and (O[1]='-');
-    If ShortOptFound then
-      For co:=low(TConfigOpt) to high(TConfigOpt) do
+  Verbose(V_DEBUG,'Parsing config file: '+aFileName);
+  Cfg:=TStringList.Create;
+  try
+    Cfg.LoadFromFile(aFileName);
+    For aLine in Cfg do
+      begin
+      S:=Trim(aLine);
+      I:=Pos('#',S);
+      If I<>0 then
+        S:=Copy(S,1,I-1);
+      If (S<>'') then
         begin
-        Found:=(O[2]=ConfigOpts[co]);
-        If Found then
+        I:=Pos('=',S);
+        if (I=0) then
+          Verbose(V_ERROR,'Unknown processing option: '+S)
+        else
           begin
-          c:=co;
-          Break;
+          N:=LowerCase(Copy(S,1,I-1));
+          V:=Copy(S,I+1,Length(S)-I);
+          ProcessOption(N,V,aConfig,aData);
           end;
         end;
-    If not ShortOptFound then
-      begin
-        Found:=false;
-        { accept long options }
-        if (copy(O,1,2)='--') then
-          begin
-            { remove -- }
-            O:=copy(O,3,length(O));
-            For co:=low(TConfigOpt) to high(TConfigOpt) do
-              begin
-              Found:=(O=ConfigStrings[co]);
-              If Found then
-                begin
-                c:=co;
-                Break;
-                end;
-              end;
-          end
       end;
-    if not Found then
-      Verbose(V_ERROR,'Illegal command-line option : '+O)
-    else
-      begin
-      if c=coverbose then
-        begin
-          Found:=true;
-          o:='';
-        end
-      else
-        Found:=(I<ParamCount);
-      If Not found then
-        Verbose(V_ERROR,'Option requires argument : '+O)
-      else
-        begin
-        inc(I);
-        O:=Paramstr(I);
-        SetOpt(c,o);
-        end;
-      end;
-    Inc(I);
-    end;
-end;
 
-Var
-  TestCPUID : Integer;
-  TestOSID  : Integer;
-  TestVersionID  : Integer;
-  TestCategoryID : Integer;
-  TestRunID : Integer;
-  ConfigID : Integer;
-
-Procedure GetIDs;
-var
-  qry : string;
-begin
-  TestCPUID := GetCPUId(TestCPU);
-  If TestCPUID=-1 then
-    Verbose(V_Error,'NO ID for CPU "'+TestCPU+'" found.');
-  TestOSID  := GetOSID(TestOS);
-  If TestOSID=-1 then
-    Verbose(V_Error,'NO ID for OS "'+TestOS+'" found.');
-  TestCategoryID := GetCategoryID(TestCategory);
-  If TestCategoryID=-1 then
-    begin
-//    Verbose(V_Error,'NO ID for Category "'+TestCategory+'" found.');
-    TestCategoryID:=1;
-    end;
-  TestVersionID  := GetVersionID(TestVersion);
-  If TestVersionID=-1 then
-    Verbose(V_Error,'NO ID for version "'+TestVersion+'" found.');
-  If (Round(TestDate)=0) then
-    Testdate:=Now;
-  TestRunID:=GetRunID(TestOSID,TestCPUID,TestVersionID,TestDate);
-  If (TestRunID=-1) then
-    begin
-    TestRunID:=AddRun(TestOSID,TestCPUID,TestVersionID,TestCategoryID,TestDate);
-    If TestRunID=-1 then
-      Verbose(V_Error,'Could not insert new testrun record!');
-    end
-  else
-    CleanTestRun(TestRunID);
-  { Add known infomration at start }
-  qry:=format('UPDATE TESTRUN SET TU_SUBMITTER=''%s'', TU_MACHINE=''%s'', TU_COMMENT=''%s'', TU_DATE=''%s''',[Submitter,Machine,Comment,SqlDate(TestDate)]);
-  qry:=qry+' WHERE TU_ID='+format('%d',[TestRunID]);
-  ExecuteQuery(Qry,False);
+  finally
+    Cfg.Free;
+  end;
 end;
 
+{ TDBDigestApplication }
 
-var
-  LongLogFile : Text;
-const
-  UseLongLog : boolean = false;
-  LongLogOpenCount : longint = 0;
-  FirstLongLogLine : boolean = true;
-const
-   SeparationLine = '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>';
-
-Function GetContentsFromLongLog(Line : String) : String;
-var
-  S : String;
-  IsFirst, IsFound : boolean;
-begin
-  Result:='';
-  IsFirst:=true;
-  IsFound:=false;
-  While Not(EOF(LongLogFile)) do
-    begin
-      ReadLn(LongLogFile,S);
-      if FirstLongLogLine then
-        begin
-          { At start of file there is a separation line }
-          if (pos(Line,S)=0) and (pos(SeparationLine,S)>=1) then
-            Readln(LongLogFile,S);
-          FirstLongLogLine:=false;
-        end;
-      if pos(Line,S)=1 then
-        begin
-          IsFound:=true;
-          while not eof(LongLogFile) do
-            begin
-              ReadLn(LongLogFile,S);
-              { End of file marker }
-              if eof(LongLogFile) 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');
-      { Restart to get a chance to find others }
-      if eof(LongLogFile) then
-        begin
-          Close(LongLogFile);
-          Reset(LongLogFile);
-          inc(LongLogOpenCount);
-        end;
-    end;
-end;
-
-Function GetLog(Line, FN : String) : String;
+Procedure TDBDigestApplication.Usage(const aMsg : 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;
+  if (aMsg<>'') then
+    Writeln('Error : ',aMsg);
+  Writeln('Usage: ',ExeName,' [options] [test run data options]');
+  Writeln('Configuration options:');
+  Writeln('-H --help                         show this help');
+  Writeln('-d --databasename=NAME            database name');
+  Writeln('-f --config=FILENAME              config file. If not set, dbdigest.cfg is used.');
+  Writeln('-h --host=HOST                    database hostname');
+  Writeln('-p --password=PWD                 database user password');
+  Writeln('-P --port=NNN                     database connection port');
+  Writeln('-r --relsrcdir                    relative source dir');
+  Writeln('-S --testsrcdir                   test source dir');
+  Writeln('-u --username=USER                database user name');
+  Writeln('-V --verbose                      be more verbose');
+  Writeln('Test run data:');
+  Writeln('-l --logfile=FILE                 set log file to analyse');
+  Writeln('-L --longlogfile=FILE             set long log filename (logs of run tests)');
+  Writeln('-o --os=OS                        set OS for testrun');
+  Writeln('-c --cpu=CPU                      set CPU');
+  Writeln('-a --category=CAT                 set category');
+  Writeln('-v --version=VER                  set compiler version');
+  Writeln('-t --date=DATE                    date in YYYMMDD(hhmmnn) format');
+  Writeln('-s --submitter=NAME               submitter name');
+  Writeln('-m --machine=NAME                 set machine name on which testsuite was run');
+  Writeln('-C --compile-flags=FLAGS          set used compilation flags');
+  Writeln('   --comment=FLAGS                backwards compatible way to set compilation flags (deprecated)');
+  Writeln('-D --description=DESC             set config description (helpful comment)');
+  Writeln('   --compilerdate=DATE            set compiler date');
+  Writeln('   --compilerfullversion=VERSION  set full compiler version');
+  Writeln('   --svncompilerrevision=REV      set revision of used compiler');
+  Writeln('   --svntestsrevision=REV         set revision of testsuite files');
+  Writeln('   --svnrtlrevision=REV           set revision of RTL');
+  Writeln('   --svnpackagesrevision=REV      set revison of packages');
+  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');
+  Writeln('comments may be included using the # character.');
+  ExitCode:=Ord(aMsg<>'');
 end;
 
-Function GetExecuteLog(Line, FN : String) : String;
+function TDBDigestApplication.ProcessCommandLine(var aConfig: TDigestConfig; var aData : TTestRunData): Boolean;
 
-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;
+  Function MakeOpts(s : string) : string;
+  var
+    C : char;
+  begin
+    Result:='';
+    For C in s do
+      begin
+      Result:=Result+C;
+      if not (C in ['V','Q']) then
+        Result:=Result+':';
+      end;
+  end;
 
-Procedure Processfile (FN: String);
+  Function MakeLongOpts(s : array of string) : TStringDynArray;
+  var
+    I : Integer;
+  begin
+    Result:=['help'];
+    SetLength(Result,1+Length(S));
+    For I:=0 to Length(S)-1 do
+      Result[1+i]:=S[I]+':'
+  end;
 
 var
-  logfile : text;
-  fullline,line,prevLine : string;
-  TS,PrevTS : TTestStatus;
-  ID,PrevID : integer;
-  Testlog : string;
-  count_test : boolean;
+  Long,ErrMsg,lValue : String;
+  Short : Char;
+  I : integer;
+  lHas : boolean;
+
 begin
-  Assign(logfile,FN);
-  PrevId:=-1;
-  PrevLine:='';
-  count_test:=false;
-  PrevTS:=low(TTestStatus);
-{$i-}
-  reset(logfile);
-  if ioresult<>0 then
-    Verbose(V_Error,'Unable to open log file'+FN);
-{$i+}
-  while not eof(logfile) do
+  ErrMsg:=CheckOptions(MakeOpts(ShortOpts)+'H',MakeLongOpts(LongOpts));
+  Result:=(ErrMsg='');
+  if (not Result) or HasOption('H','help') then
+    begin
+    Usage(ErrMsg);
+    Exit(false);
+    end;
+  I:=0;
+  For Long in LongOpts do
     begin
-    readln(logfile,line);
-    fullline:=line;
-    ts:=stFailedToCompile;
-    If analyse(line,TS) then
+    Inc(I);
+    if I<=Length(ShortOpts) then
       begin
-      Verbose(V_NORMAL,'Analysing result for test '+Line);
-      If Not ExpectRun[TS] then
-        begin
-        ID:=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:='';
-            AddTestResult(PrevID,TestRunId,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 AddTestResult(ID,TestRunID,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:=RequireTestID(line);
-          PrevLine:=line;
-        end;
-
+      Short:=ShortOpts[I];
+      if Short='r' then
+        Writeln('ag');
+      lHas:=HasOption(Short,Long);
+      lValue:=GetOptionValue(Short,Long);
       end
     else
       begin
-        Inc(UnknownLines);
-        Verbose(V_Warning,'Unknown line: "'+line+'"');
+      Short:=#0;
+      lHas:=HasOption(Long);
+      lValue:=GetOptionValue(Long);
       end;
+    if lHas then
+      ProcessOption(long,lValue,aConfig,aData);
     end;
-  close(logfile);
+  Result:=True;
 end;
 
-procedure UpdateTestRun;
+procedure TDBDigestApplication.Analyze(const aConfig : TDigestConfig; 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 TestCompilerDate<>'' then
-      qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coCompilerDate],EscapeSQL(TestCompilerDate)]);
-    if TestCompilerFullVersion<>'' then
-      qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coCompilerFullVersion],EscapeSQL(TestCompilerFullVersion)]);
-    if TestSvnCompilerRevision<>'' then
-      qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnCompilerRevision],EscapeSQL(TestSvnCompilerRevision)]);
-    if TestSvnTestsRevision<>'' then
-      qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnTestsRevision],EscapeSQL(TestSvnTestsRevision)]);
-    if TestSvnRTLRevision<>'' then
-      qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnRTLRevision],EscapeSQL(TestSvnRTLRevision)]);
-    if TestSvnPackagesRevision<>'' then
-      qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnPackagesRevision],EscapeSQL(TestSvnPackagesRevision)]);
-
-    qry:=qry+format('TU_SUBMITTER=''%s'', TU_MACHINE=''%s'', TU_COMMENT=''%s'', TU_DATE=''%s''',[Submitter,Machine,Comment,SqlDate(TestDate)]);
-    qry:=qry+' WHERE TU_ID='+format('%d',[TestRunID]);
-    ExecuteQuery(Qry,False);
-  end;
-
-function GetTestConfigId : Integer;
 var
-  qry : string;
+  lSQL : TTestSQL;
+  lDigest : TDBDigestAnalyzer;
+
 begin
-  qry:='SELECT TCONF_ID FROM TESTCONFIG WHERE ' +
-       'TCONF_CPU_FK=%d AND ' +
-       'TCONF_OS_FK=%d AND ' +
-       'TCONF_VERSION_FK=%d AND ' +
-       'TCONF_CATEGORY_FK=%d AND ' +
-       'TCONF_SUBMITTER=''%s'' AND ' +
-       'TCONF_MACHINE=''%s'' AND ' +
-       'TCONF_COMMENT=''%s'' ';
-  ConfigID:=IDQuery(format(qry,[TestCPUID, TestOSID, TestVersionID, TestCategoryID,
-                                Submitter, Machine, Comment]));
-  GetTestConfigID:=ConfigID;
+  lDigest:=Nil;
+  With aConfig do
+    lSQL:=TTestSQL.create(databasename,host,username,password,port);
+  try
+    lSQL.ConnectToDatabase;
+    lDigest:=TDBDigestAnalyzer.Create(lSQL);
+    lDigest.Analyse(aConfig,aData);
+  finally
+    lDigest.Free;
+    lSQL.Free;
+  end;
 end;
 
-function UpdateTestConfigID : boolean;
+procedure TDBDigestApplication.ReadSystemDBConfig(var aConfig : TDigestConfig);
+
+// Keep filename in sync with algorithm in dbadd
+
 var
-  qry : string;
-  firstRunID, lastRunID,PrevRunID : Integer;
-  RunCount : Integer;
-  AddCount : boolean;
+  lFileName : String;
+  Ini : TCustomIniFile;
 
 begin
-  AddCount:=false;
-  UpdateTestConfigID:=false;
-  qry:=format('SELECT TCONF_FIRST_RUN_FK FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
-  FirstRunID:=IDQuery(qry);
-  if TestRunID<FirstRunID then
-    begin
-      Verbose(V_Warning,format('FirstRunID changed from %d to %d',[FirstRunID,TestRunID]));
-      qry:=format('UPDATE TESTCONFIG SET TCONF_FIRST_RUN_FK=%d WHERE TCONF_ID=%d',
-                  [TestRunID,ConfigID]);
-      if Not ExecuteQuery(qry,False) then
-        Verbose(V_Warning,'Update of LastRunID failed');
+  lFileName:='/etc/dbdigest.ini';
+  if not FileExists(lFileName) then exit;
+  Ini:=TMemIniFile.Create(lFileName);
+  With Ini do
+    try
+      aConfig.DatabaseName:=ReadString(SSection,KeyName,'testsuite');
+      aConfig.Host:=ReadString(SSection,KeyHost,'localhost');
+      aConfig.UserName:=ReadString(SSection,KeyUser,'');
+      aConfig.Password:=ReadString(SSection,KeyPassword,'');
+      aConfig.Port:=ReadInteger(SSection,KeyPort,0);
+    finally
+      Ini.Free;
     end;
-  qry:=format('SELECT TCONF_LAST_RUN_FK FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
-  LastRunID:=IDQuery(qry);
-  if TestRunID>LastRunID then
-    begin
-      qry:=format('UPDATE TESTCONFIG SET TCONF_LAST_RUN_FK=%d WHERE TCONF_ID=%d',
-                  [TestRunID,ConfigID]);
-      if not ExecuteQuery(qry,False) then
-        Verbose(V_Warning,'Update of LastRunID failed');
-    end
-   else
-    Verbose(V_Warning,format('LastRunID %di,new %d',[LastRunID,TestRunID]));
-  qry:=format('SELECT TCONF_NEW_RUN_FK FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
-  PrevRunID:=IDQuery(qry);
-  if TestRunID<>PrevRunID then
-    begin
-    qry:=format('UPDATE TESTCONFIG SET TCONF_NEW_RUN_FK=%d WHERE TCONF_ID=%d',
-                [TestRunID,ConfigID]);
-    if not ExecuteQuery(qry,False) then
-      Verbose(V_Warning,'Update of LastRunID failed');
-    AddTestHistoryEntry(TestRunID,PrevRunID);
-    AddCount:=true;
-    end
-  else
-    Verbose(V_Warning,'TestRunID is equal to last!');
-  qry:=format('SELECT TCONF_COUNT_RUNS FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
-  RunCount:=IDQuery(qry);
-  { Add one to run count }
-  if AddCount then
-    begin
-      Inc(RunCount);
-      qry:=format('UPDATE TESTCONFIG SET TCONF_COUNT_RUNS=%d WHERE TCONF_ID=%d',
-                  [RunCount,ConfigID]);
-      if not ExecuteQuery(qry,False) then
-        Verbose(V_Warning,'Update of TU_COUNT_RUNS failed');
-    end;
-  UpdateTestConfigID:=true;
 end;
 
-function InsertNewTestConfigId : longint;
+procedure TDBDigestApplication.DoRun;
+
 var
-  qry : string;
+  lConfigFile : String;
+  lConfig : TDigestConfig;
+  lData : TTestRunData;
 begin
-  qry:='INSERT INTO TESTCONFIG '+
-        '(TCONF_NEW_RUN_FK,TCONF_FIRST_RUN_FK,TCONF_LAST_RUN_FK,' +
-         'TCONF_CPU_FK,TCONF_OS_FK,TCONF_VERSION_FK,TCONF_CATEGORY_FK,'+
-         'TCONF_SUBMITTER,TCONF_MACHINE,TCONF_COMMENT,'+
-         'TCONF_NEW_DATE,TCONF_FIRST_DATE,TCONF_LAST_DATE) ';
-  qry:=qry+format(' VALUES(%d,%d,%d,%d,%d,%d,%d,''%s'',''%s'',''%s'',''%s'',''%s'',''%s'') ',
-                  [TestRunID, TestRunID, TestRunID, TestCPUID,
-                   TestOSID, TestVersionID, TestCategoryID,
-                   Submitter, Machine, Comment,
-                   SqlDate(TestDate), SqlDate(TestDate), SqlDate(TestDate)]);
-  qry:=qry+' RETURNING TCONF_ID';
-  Result:=InsertQuery(qry);
-  AddTestHistoryEntry(TestRunID,0);
+  Terminate;
+  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);
 end;
 
-procedure UpdateTestConfig;
-
-  begin
-    if GetTestPreviousRunHistoryID(TestRunID) <> -1 then
-      begin
-      Verbose(V_DEBUG,format('TestRun %d already in TestHistory table',[TestRunID]));
-      exit;
-      end;
-
-    if GetTestConfigID >= 0 then
-      begin
-        if not UpdateTestConfigID then
-          Verbose(V_Warning, ' Update of TESTCONFIG table failed');
-      end
-    else
-      begin
-        if InsertNewTestConfigID = -1 then
-          Verbose(V_Warning, ' Insert of new entry into TESTCONFIG table failed');
-      end;
-  end;
-
+var
+  Application : TDBDigestApplication;
 
 begin
-  ProcessConfigFile('dbdigest.cfg');
-  ProcessCommandLine;
-  If LogFileName<>'' then
-    begin
-    ConnectToDatabase(DatabaseName,HostName,UserName,Password,Port);
-    if LongLogFileName<>'' then
-      begin
-{$I-}
-        Assign(LongLogFile,LongLogFileName);
-        Reset(LongLogFile);
-        If IOResult=0 then
-          begin
-            UseLongLog:=true;
-            inc(LongLogOpenCount);
-          end;
-{$I+}
-      end;
-    GetIDs;
-    ProcessFile(LogFileName);
-    UpdateTestRun;
-    UpdateTestConfig;
-    if UseLongLog then
-      begin
-        Close(LongLogFile);
-        if LongLogOpenCount>1 then
-          Verbose(V_Warning,format('LongLog file was read %d times.',[LongLogOpenCount]));
-      end
-    end
-  else
-    Verbose(V_ERROR,'Missing log file name');
+  Application:=TDBDigestApplication.Create(Nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
 end.

tests/utils/dbtests.pp

@@ -6,13 +6,24 @@ unit dbtests;
 Interface
 
 Uses
-  sqldb, testu, pqconnection;
+  sqldb, tresults, testu, pqconnection;
+
+const
+  // Ini file constants
+  SSection    = 'Database';
+  KeyName     = 'Name';
+  KeyHost     = 'Host';
+  KeyUser     = 'UserName';
+  KeyPassword = 'Password';
+  KeyPort     = 'Port';
 
 Type
 
   { TTestSQL }
 
   TTestSQL = class(TObject)
+  Const
+    Bools : Array[Boolean] of String = ('f','t');
   private
     FRelSrcDir: String;
     FTestSrcDir: string;
@@ -21,20 +32,17 @@ Type
     FHost : String;
     FUser : String;
     FPassword : String;
-    FPort : String;
+    FPort : Word;
 
     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;
@@ -43,25 +51,37 @@ Type
     { ---------------------------------------------------------------------
       High-level access
       ---------------------------------------------------------------------}
-    Constructor create (aDatabaseName,aHost,aUser,aPassword,aPort : String);
+    Constructor create(aDatabaseName,aHost,aUser,aPassword : String; aPort : Word);
+    Destructor destroy; override;
     Function ConnectToDatabase : Boolean;
+    Function  ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
     Procedure DisconnectDatabase;
+    // Adding things
+    Function AddCategory(const aName : String) : Integer;
+    Function AddCPU(const aName : String) : Integer;
+    Function AddOS(const aName : String) : Integer;
+    function AddVersion(const aName: String; aReleaseDate: TDateTime): Integer;
+    Function AddPlatform(const aData : TTestRunData) : Integer;
+    Function AddTest(Name : String; AddSource : Boolean) : Integer;
+    function AddRun(const aData: TTestRunData): Int64;
+    Function AddTestResult(aData : TTestResultData) : Int64;
+    function AddLastResult(TestID, PlatformID: Integer; ResultID: Int64): Boolean;
+    // Get ID based on key
     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 GetPlatformID(aData: TTestRunData; aAllowCreate: Boolean): Integer;
+    Function GetRunID(aData : TTestRunData) : Int64;
+    function GetLastTestResult(aTestID, aPlatFormID: Integer): TTestResultData;
+    //
     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 UpdateTestResult(aData: TTestResultData): Int64;
+    function UpdateTestRun(aData : TTestRunData): Boolean;
     Function RequireTestID(Name : String): Integer;
     Function CleanTestRun(ID : Integer) : Boolean;
-
-    Class Function  EscapeSQL( S : String) : String;
+    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;
@@ -82,7 +102,7 @@ function TTestSQL.ConnectToDatabase: Boolean;
 
 begin
   Result:=False;
-  Verbose(V_SQL,'Connection params : '+FDatabaseName+' '+FHost+' '+FUser+' '+FPort);
+  Verbose(V_SQL,'Connection params : '+FDatabaseName+' '+FHost+' '+FUser+' '+IntToStr(FPort));
   FConnection:=TPQConnection.Create(Nil);
   try
     FConnection.Hostname:=FHost;
@@ -91,8 +111,10 @@ begin
     FConnection.Password:=FPassword;
     FConnection.Connected:=true;
     FConnection.Transaction:=TSQLTransaction.Create(FConnection);
-    if (FPort<>'') then
-      FConnection.Params.Values['Port']:=FPort;
+    if (FPort<>0) then
+      FConnection.Params.Values['Port']:=IntToStr(FPort);
+    FConnection.Connected:=True;
+    Result:=True
   except
     On E : Exception do
       begin
@@ -108,6 +130,41 @@ begin
   FreeAndNil(FConnection);
 end;
 
+function TTestSQL.AddCategory(const aName: String): Integer;
+
+Const
+  SQLInsert = 'INSERT INTO TESTCATEGORY (TA_NAME) VALUES (''%s'') RETURNING TA_ID';
+
+begin
+  Result:=IDQuery(Format(SQLInsert,[EscapeSQL(aName)]));
+end;
+
+function TTestSQL.AddCPU(const aName: String): Integer;
+
+Const
+  SQLInsert = 'INSERT INTO TESTCPU (TC_NAME) VALUES (''%s'') RETURNING TC_ID';
+
+begin
+  Result:=IDQuery(Format(SQLInsert,[EscapeSQL(aName)]));
+end;
+
+function TTestSQL.AddOS(const aName: String): Integer;
+Const
+  SQLInsert = 'INSERT INTO TESTOS (TO_NAME) VALUES (''%s'') RETURNING TO_ID';
+
+begin
+  Result:=IDQuery(Format(SQLInsert,[EscapeSQL(aName)]));
+end;
+
+function TTestSQL.AddVersion(const aName: String; aReleaseDate : TDateTime): Integer;
+Const
+  SQLInsert = 'INSERT INTO TESTVERSION (TV_VERSION,TV_RELEASEDATE) VALUES (''%s'',''%s'') RETURNING TV_ID';
+
+begin
+  Result:=IDQuery(Format(SQLInsert,[EscapeSQL(aName),SQLDate(aReleaseDate)]));
+end;
+
+
 function TTestSQL.CreateQuery(const ASQL: String): TSQLQuery;
 
 begin
@@ -118,7 +175,6 @@ begin
 end;
 
 
-
 function TTestSQL.ExecuteQuery(Qry: String; Silent: Boolean): Boolean;
 
 begin
@@ -170,7 +226,7 @@ class function TTestSQL.GetIntResultField(Res: TSQLQuery; Id: Integer): Integer;
 
 
 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].AsInteger;
@@ -195,6 +251,18 @@ begin
   Verbose(V_SQL,'Field value '+Result);
 end;
 
+function TTestSQL.AddPlatform(const aData : TTestRunData) : Integer;
+
+const
+  SQLInsert = 'INSERT INTO TESTPLATFORM (TP_CPU_FK, TP_OS_FK, TP_VERSION_FK, TP_CATEGORY_FK, TP_CONFIG) '+
+              ' VALUES (%d, %d, %d, %d, ''%s'') '+
+              '  RETURNING TP_ID';
+
+begin
+  With aData do
+    Result:=IDQuery(Format(SQLInsert,[CPUID,OSID,VersionID,CategoryID,EscapeSQL(config)]));
+end;
+
 class procedure TTestSQL.FreeQueryResult(var Res: TSQLQuery);
 
 begin
@@ -247,12 +315,22 @@ begin
     end;
 end;
 
-constructor TTestSQL.create(aDatabaseName, aHost, aUser, aPassword, aPort: String);
+constructor TTestSQL.create(aDatabaseName, aHost, aUser, aPassword: String; aPort: Word);
 begin
+  FDatabaseName:=aDatabaseName;
+  FHost:=aHost;
+  FUser:=aUser;
+  FPassword:=aPassword;
+  FPort:=aPort;
+end;
 
+destructor TTestSQL.destroy;
+begin
+  DisconnectDatabase;
+  inherited destroy;
 end;
 
-Function EscapeSQL( S : String) : String;
+class function TTestSQL.EscapeSQL(S: String): String;
 
 begin
 //  Result:=StringReplace(S,'\','\\',[rfReplaceAll]);
@@ -261,7 +339,7 @@ begin
 end;
 
 
-Function SQLDate(D : TDateTime) : String;
+class function TTestSQL.SQLDate(D: TDateTime): String;
 
 begin
   Result:=FormatDateTime('YYYY/MM/DD hh:nn:ss',D);
@@ -299,6 +377,24 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
+function TTestSQL.GetPlatformID(aData: TTestRunData; aAllowCreate: Boolean): Integer;
+
+Const
+  SQLSelect = 'SELECT TP_ID FROM TESTPLATFORM ' +
+             ' WHERE ' +
+             '  (TP_VERSION_FK=%d)' +
+             '  AND (TP_OS_FK=%d)' +
+             '  AND (TP_CPU_FK=%d)' +
+             '  AND (TP_CATEGORY_FK=%d)' +
+             '  AND (TP_CONFIG=''%s'')';
+
+begin
+  With aData do
+    Result:=IDQuery(Format(SQLSelect,[VersionID,OSID,CPUID,CategoryID,Config]));
+  if (Result=-1) and aAllowCreate then
+    Result:=AddPlatform(aData)
+end;
+
 function TTestSQL.GetCPUID(Name: String): Integer;
 
 Const
@@ -311,159 +407,88 @@ end;
 function TTestSQL.GetCategoryID(Name: String): Integer;
 
 Const
-  SFromName = 'SELECT TCAT_ID FROM TESTCATEGORY WHERE (TCAT_NAME=''%s'')';
+  SFromName = 'SELECT TA_ID FROM TESTCATEGORY WHERE (TA_NAME=''%s'')';
 
 begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-function TTestSQL.GetRunID(OSID, CPUID, VERSIONID: Integer; Date: TDateTime): Integer;
+function TTestSQL.GetRunID(aData: TTestRunData): Int64;
 
 
 Const
   SFromIDS = 'SELECT TU_ID FROM TESTRUN WHERE '+
-             ' (TU_OS_FK=%d) '+
-             ' AND (TU_CPU_FK=%d) '+
-             ' AND (TU_VERSION_FK=%d) '+
+             ' (TU_PLATFORM_FK=%d) '+
              ' AND (TU_DATE=''%s'')';
 
 begin
-  Result:=IDQuery(Format(SFromIDS,[OSID,CPUID,VERSIONID,SQLDate(Date)]));
-end;
-
-function TTestSQL.InsertQuery(const Query: string): Integer;
-
-begin
-  Result:=IDQuery(Query);
+  With aData do
+    Result:=ID64Query(Format(SFromIDS,[PlatFormID,SQLDate(Date)]));
 end;
 
-function TTestSQL.AddRun(OSID, CPUID, VERSIONID, CATEGORYID: Integer; Date: TDateTime): Integer;
+function TTestSQL.AddRun(const aData : TTestRunData): Int64;
 
 Const
   SInsertRun = 'INSERT INTO TESTRUN '+
-               '(TU_OS_FK,TU_CPU_FK,TU_VERSION_FK,TU_CATEGORY_FK,TU_DATE)'+
+               '(TU_PLATFORM_FK, TU_MACHINE, TU_SUBMITTER, TU_DATE, '+
+               ' TU_COMPILERDATE, TU_COMPILERFULLVERSION, TU_COMPILERREVISION, '+
+               ' TU_TESTSREVISION, TU_RTLREVISION, TU_PACKAGESREVISION  )'+
                ' VALUES '+
-               '(%d,%d,%d,%d,''%s'') RETURNING TU_ID';
+               '(%d,''%s'',''%s'',''%s'', '+
+               ' ''%s'',''%s'',''%s'', '+
+               ' ''%s'',''%s'',''%s'' '+
+               ') RETURNING TU_ID';
+
 var
   Qry : string;
 begin
-  qry:=Format(SInsertRun,[OSID,CPUID,VERSIONID,CATEGORYID,SQLDate(Date)]);
+  With aData do
+    qry:=Format(SInsertRun,[PlatformID,
+                            EscapeSQL(Machine),
+                            EscapeSQL(Submitter),
+                            SQLDate(Date),
+                            EscapeSQL(CompilerDate),
+                            EscapeSQL(CompilerFullVersion),
+                            EscapeSQL(CompilerRevision),
+                            EscapeSQL(TestsRevision),
+                            EscapeSQL(RTLRevision),
+                            EscapeSQL(PackagesRevision)]);
   Result:=IDQuery(Qry);
 end;
 
-function posr(c : Char; const s : AnsiString) : integer;
-var
-  i : integer;
-begin
-  i := length(s);
-  while (i>0) and (s[i] <> c) do dec(i);
-  Result := i;
-end;
 
-function TTestSQL.GetUnitTestConfig(const fn : string; var r : TConfig) : Boolean;
-var
-  Path       : string;
-  lClassName  : string;
-  lMethodName : string;
-  slashpos   : integer;
-  FileName   : string;
-  s          : string;
-  t          : text;
-begin
-  Result := False;
-  FillChar(r,sizeof(r),0);
-  if pos('.',fn) > 0 then exit; // This is normally not a unit-test
-  slashpos := posr('/',fn);
-  if slashpos < 1 then exit;
-  lMethodName := copy(fn,slashpos+1,length(fn));
-  Path := copy(fn,1,slashpos-1);
-  slashpos := posr('/',Path);
-  if slashpos > 0 then
-    begin
-    lClassName := copy(Path,slashpos+1,length(Path));
-    Path := copy(Path,1,slashpos-1);
-    end
-  else
-    begin
-    lClassName := Path;
-    path := '.';
-    end;
-  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
-    FileName := FileName + '.pp'
-  else exit;
-
-  Verbose(V_Debug,'Reading: '+FileName);
-  assign(t,FileName);
-  {$I-}
-   reset(t);
-  {$I+}
-  if ioresult<>0 then
-   begin
-     Verbose(V_Error,'Can''t open '+FileName);
-     exit;
-   end;
-  while not eof(t) do
-   begin
-     readln(t,s);
-
-     if s<>'' then
-      begin
-        TrimB(s);
-        if SameText(copy(s,1,9),'PROCEDURE') then
-         begin
-           if pos(';',s)>11 then
-            begin
-              s := copy(s,11,pos(';',s)-11);
-              TrimB(s);
-              if SameText(s,lClassName+'.'+lMethodName) then
-               begin
-                 Result := True;
-                 r.Note:= 'unittest';
-               end;
-            end;
-         end;
-      end;
-   end;
-  close(t);
-end;
 
 function TTestSQL.AddTest(Name: String; AddSource: Boolean): Integer;
 
 Const
   SInsertTest = 'INSERT INTO TESTS (T_NAME,T_ADDDATE)'+
-                ' VALUES (''%s'',NOW())';
+                ' VALUES (''%s'',NOW()) RETURNING T_ID';
 
 Var
   Info : TConfig;
-
+  lSrcDir : String;
+  lFileName : string;
 begin
+  Info:=Default(TConfig);
   Result:=-1;
-  If (FileExists(TestSrcDir+RelSrcDir+Name) and
-     GetConfig(TestSrcDir+RelSrcDir+Name,Info)) or
-     GetUnitTestConfig(Name,Info) then
+  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
     begin
-    If ExecuteQuery(Format(SInsertTest,[Name]),False) then
-      begin
-      Result:=GetTestID(Name);
-      If Result=-1 then
-        Verbose(V_WARNING,'Could not find newly added test!')
-      else
-        If AddSource then
-          UpdateTest(Result,Info,testu.GetFileContents(Name))
-        else
-          UpdateTest(Result,Info,'');
-      end
+    Result:=IDQuery(Format(SInsertTest,[Name]));
+    If Result=-1 then
+      Verbose(V_WARNING,'Could not add test!')
+    else If AddSource then
+      UpdateTest(Result,Info,testu.GetFileContents(Name))
+    else
+      UpdateTest(Result,Info,'');
     end
   else
-    Verbose(V_ERROR,'Could not find test "'+Name+'" or info about this test.');
+    Verbose(V_WARNING,'Could not find test "'+Name+'" or info about this test.');
 end;
 
-Const
-  B : Array[Boolean] of String = ('f','t');
 
 function TTestSQL.UpdateTest(ID: Integer; Info: TConfig; Source: String): Boolean;
 
@@ -490,59 +515,142 @@ begin
     end;
   With Info do
     Qry:=Format(SUpdateTest,[EscapeSQL(NeedCPU),'',EscapeSQL(MinVersion),
-                             B[usesGraph],B[IsInteractive],ResultCode,
-                             B[ShouldFail],B[NeedRecompile],B[NoRun],
-                             B[NeedLibrary],KnownRunError,
-                             B[IsKnownCompileError],EscapeSQL(Note),EscapeSQL(NeedOptions),
+                             Bools[usesGraph],Bools[IsInteractive],ResultCode,
+                             Bools[ShouldFail],Bools[NeedRecompile],Bools[NoRun],
+                             Bools[NeedLibrary],KnownRunError,
+                             Bools[IsKnownCompileError],EscapeSQL(Note),EscapeSQL(NeedOptions),
                              Source,
                              ID
      ]);
   Result:=ExecuteQuery(Qry,False);
 end;
 
-function TTestSQL.AddTestResult(TestID, RunID, TestRes: Integer; OK, Skipped: Boolean; Log: String; var count_it: boolean): Int64;
+function TTestSQL.UpdateTestResult(aData: TTestResultData): Int64;
+
+const
+  SQLUpdate = 'UPDATE TESTRESULTS SET '+
+              '  TR_RESULT = %d, '+
+              '  TR_TESTRUN_FK = %d, '+
+              '  TR_OK = ''%s'', '+
+              '  TR_SKIP = ''%s'', '+
+              '  TR_LOG = ''%s'' '+
+              'WHERE (TR_ID=%d)';
+var
+  Qry : String;
+  OK, Skipped : Boolean;
+
+begin
+  with aData do
+    begin
+    OK:=TestOK[TestResult];
+    Skipped:=TestSkipped[TestResult];
+    Qry:=Format(SQLUpdate, [Ord(TestResult),RunID,Bools[OK],Bools[Skipped],EscapeSQL(Log),aData.ID]);
+    Result:=aData.ID;
+    end;
+  ExecuteQuery(Qry,False);
+end;
+
+function TTestSQL.AddTestResult(aData: TTestResultData): Int64;
 
 Const
-  SInsertRes='Insert into TESTRESULTS '+
-             '(TR_TEST_FK,TR_TESTRUN_FK,TR_OK,TR_SKIP,TR_RESULT) '+
-             ' VALUES '+
-             '(%d,%d,''%s'',''%s'',%d) RETURNING TR_ID';
-  SSelectId='SELECT TR_ID FROM TESTRESULTS WHERE (TR_TEST_FK=%d) '+
-            ' AND (TR_TESTRUN_FK=%d)';
-  SSelectTestResult='SELECT TR_RESULT FROM TESTRESULTS WHERE (TR_TEST_FK=%d) '+
-            ' AND (TR_TESTRUN_FK=%d)';
-  SInsertLog='Update TESTRESULTS SET TR_LOG=''%s'''+
-             ',TR_OK=''%s'',TR_SKIP=''%s'',TR_RESULT=%d WHERE (TR_ID=%d)';
+  SQLInsert = 'Insert into TESTRESULTS '+
+              '  (TR_TEST_FK,TR_TESTRUN_FK,TR_OK,TR_SKIP,TR_RESULT,TR_LOG) '+
+              'VALUES '+
+              '  (%d,%d,''%s'',''%s'',%d, ''%s'') '+
+              'ON CONFLICT (TR_TEST_FK,TR_TESTRUN_FK) '+
+              'DO UPDATE SET '+
+              '  TR_OK = EXCLUDED.TR_OK, '+
+              '  TR_SKIP = EXCLUDED.TR_SKIP, '+
+              '  TR_RESULT = EXCLUDED.TR_RESULT, '+
+              '  TR_LOG = EXCLUDED.TR_LOG '+
+              'RETURNING TR_ID ';
+
 Var
   Qry : String;
-  updateValues : boolean;
-  prevTestResult : integer;
+  OK, Skipped : Boolean;
+
 begin
-  updateValues:=false;
   Result:=-1;
-  prevTestResult:=-1;
-  Qry:=Format(SInsertRes,
-              [TestID,RunID,B[OK],B[Skipped],TestRes]);
-  Result:=IDQuery(Qry);
-  if (Result=-1) then
-    begin
-    Qry:=format(SSelectId,[TestId,RunId]);
-    Result:=IDQuery(Qry);
-    if Result<>-1 then
-      begin
-      UpdateValues:=true;
-      Qry:=format(SSelectTestResult,[TestId,RunId]);
-      prevTestResult:=IDQuery(Qry);
-      end;
-    end;
-  if (Result<>-1) and ((Log<>'') or updateValues) then
+  With aData do
     begin
-    Qry:=Format(SInsertLog,[EscapeSQL(Log),B[OK],B[Skipped],TestRes,Result]);
-    if Not ExecuteQuery(Qry,False) then
-       Verbose(V_Warning,'Insert Log failed');
+    OK:=TestOK[TestResult];
+    Skipped:=TestSkipped[TestResult];
+    Qry:=Format(SQLInsert, [TestID,RunID,Bools[OK],Bools[Skipped],Ord(TestResult),EscapeSQL(Log)]);
     end;
-  { If test already existed, return false for count_it to avoid double counting }
-  count_it:=not updateValues or (prevTestResult<>TestRes);
+  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) '+
+              'WHERE '+
+              ' (TL_TEST_FK=%d) '+
+              ' AND (TL_PLATFORM_FK=%d)';
+
+var
+  Qry : TSQLQuery;
+
+begin
+  Result:=Default(TTestResultData);
+  Result.TestID:=aTestID;
+  Result.PlatformID:=aPlatformID;
+  Qry:=CreateQuery(Format(SQLSelect,[aTestID,aPlatformID]));
+  try
+    Qry.Open;
+    If not Qry.IsEmpty then
+      begin
+      Result.ID:=Qry.FieldByName('TR_ID').AsLargeInt;
+      Result.TestResult:=TTestStatus(Qry.FieldByName('TR_RESULT').AsInteger);
+      Result.RunID:=Qry.FieldByName('TR_TESTRUN_FK').AsLargeInt;
+      Result.Log:=Qry.FieldByName('TR_LOG').AsString;
+      end
+    else
+      Result.ID:=-1;
+  finally
+    if Qry.SQLTransaction.Active then
+      Qry.SQLTransaction.Commit;
+    Qry.Free;
+  end;
+
+end;
+
+function TTestSQL.AddLastResult(TestID, PlatformID: Integer; ResultID: Int64) : Boolean;
+
+const
+  SQLInsert = 'Insert into TESTLASTRESULTS '+
+             '  (TL_TEST_FK,TL_PLATFORM_FK,TL_TESTRESULTS_FK) '+
+             'VALUES '+
+             '  (%d,%d,%d) '+
+             'ON CONFLICT (TL_TEST_FK,TL_PLATFORM_FK) '+
+             'DO UPDATE SET TL_TESTRESULTS_FK = EXCLUDED.TL_TESTRESULTS_FK ';
+
+begin
+  Result:=ExecuteQuery(Format(SQLInsert,[TestId,PlatFormID,ResultID]),False);
+end;
+
+function TTestSQL.UpdateTestRun(aData: TTestRunData): Boolean;
+var
+  Qry : string;
+  I : TTestStatus;
+
+  Procedure AddTo(S : String);
+
+  begin
+    if Qry<>'' then
+      Qry:=Qry+' , ';
+    Qry:=Qry+S;
+  end;
+
+begin
+  Qry:='';
+  for i:=low(TTestStatus) to high(TTestStatus) do
+    AddTo(format('%s=%d',[SQLField[i],aData.StatusCount[i]]));
+  qry:='UPDATE TESTRUN SET '+Qry+' WHERE TU_ID='+format('%d',[aData.RunID]);
+  ExecuteQuery(Qry,False);
+  Result:=True;
 end;
 
 function TTestSQL.RequireTestID(Name: String): Integer;
@@ -550,7 +658,7 @@ function TTestSQL.RequireTestID(Name: String): Integer;
 begin
   Result:=GetTestID(Name);
   If Result=-1 then
-    Result:=AddTest(Name,FileExists(Name));
+    Result:=AddTest(Name,True);
   If Result=-1 then
     Verbose(V_WARNING,'Could not find or create entry for test '+Name);
 end;
@@ -564,14 +672,5 @@ begin
   Result:=ExecuteQuery(Format(SDeleteRun,[ID]),False);
 end;
 
-class function TTestSQL.EscapeSQL(S: String): String;
-begin
-
-end;
-
-class function TTestSQL.SQLDate(D: TDateTime): String;
-begin
-
-end;
 
 end.

tests/utils/digestanalyst.pas

@@ -8,143 +8,105 @@ uses
   Classes, SysUtils, teststr, testu, tresults, dbtests;
 
 Type
+  // Program configuration
   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;
+    port: integer;
     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;
+  private
+    FDB : TTestSQL;
     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 CheckIDs(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 Processfile(const aFileName: String; var aData: TTestRunData);
+    function SaveTestResult(aResult: TTestResultData): Boolean;
     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;
+  public
+    constructor Create(aDB : TTestSQL);
+    class function AnalyseLine(var Line: string; var Status: TTestStatus): Boolean;
+    class procedure ExtractTestFileName(var Line: string);
+    procedure Analyse(aConfig : TDigestConfig; aData : TTestRunData);
   end;
 
 
 implementation
 
-constructor TDBDigestAnalyzer.Create(aDB: TTestDB);
+constructor TDBDigestAnalyzer.Create(aDB: TTestSQL);
 begin
   FDB:=aDB;
 end;
 
-function TDBDigestAnalyzer.CheckIDs(aConfig : TDigestConfig; var aData : TTestRunData): Boolean;
+function TDBDigestAnalyzer.CheckIDs(var aData : TTestRunData): Boolean;
 
 begin
   If aData.CategoryID=-1 then
     aData.CategoryID:=1;
-  // Checks
+  Result:=(aData.CPUID<>-1) and (aData.OSID<>-1) and (aData.VersionID<>-1);
+  if Result then
+    exit;
   If aData.CPUID=-1 then
-    Verbose(V_Error,'NO ID for CPU "'+aConfig.CPU+'" found.');
+    Verbose(V_Error,'NO ID for CPU "'+aData.CPU+'" found.');
   If aData.OSID=-1 then
-    Verbose(V_Error,'NO ID for OS "'+aConfig.OS+'" found.');
+    Verbose(V_Error,'NO ID for OS "'+aData.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);
+    Verbose(V_Error,'NO ID for version "'+aData.Version+'" found.');
 end;
 
-procedure TDBDigestAnalyzer.Analyse(aConfig: TDigestConfig);
-
-var
-  lData : TTestRunData;
+procedure TDBDigestAnalyzer.Analyse(aConfig: TDigestConfig; aData : TTestRunData);
 
 begin
-  lData:=Default(TTestRunData);
-  if (aConfig.longlogfile<>'') and FileExists(aConfig.longlogfile) then
+  FDB.RelSrcDir:=aConfig.relsrcdir;
+  FDB.TestSrcDir:=aConfig.testsrcdir;
+  if (aData.longlogfile<>'') and FileExists(aData.longlogfile) then
     begin
     LongLogFile:=TStringList.Create;
-    LongLogFile.LoadFromFile(aConfig.longlogfile);
+    LongLogFile.LoadFromFile(aData.longlogfile);
     end;
-  if not GetIDS(aConfig,lData) then
+  if not GetIDS(aConfig,aData) then
     exit;
-  UpdateTestRunBefore(aConfig,lData);
-  ProcessFile(aConfig.logfile,lData);
-  UpdateTestRun(lData);
+  ProcessFile(aData.logfile,aData);
+  UpdateTestRun(aData);
 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);
+  Result := False;
+  aData.CPUID := FDB.GetCPUID(aData.CPU);
+  aData.OSID := FDB.GetOSID(aData.OS);
+  aData.VersionID := FDB.GetVersionID(aData.Version);
+  aData.CategoryID := FDB.GetCategoryID(aData.Category);
+  aData.PlatformID := FDB.GetPlatformID(aData,True);
   If (Round(aData.Date)=0) then
-    aData.Date:=Now;
-  Result:=CheckIDS(aConfig,aData);
+    aData.Date:=Date;
+  Result:=CheckIDS(aData);
   if not Result then
     Exit;
-  aData.RunID:=FDB.GetRunID(aData.OSID,aData.CPUID,aData.VersionID,aData.Date);
+  aData.RunID:=FDB.GetRunID(aData);
   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);
+    aData.RunID:=FDB.AddRun(aData);
     Result:=aData.RunID<>-1;
     if not Result then
       begin
@@ -154,7 +116,7 @@ begin
     end;
 end;
 
-Procedure ExtractTestFileName(Var Line : string);
+class procedure TDBDigestAnalyzer.ExtractTestFileName(var Line: string);
 
 Var I : integer;
 
@@ -164,7 +126,7 @@ begin
     Line:=Copy(Line,1,I-1);
 end;
 
-Function AnalyseLine(Var Line : string; Var Status : TTestStatus) : Boolean;
+class function TDBDigestAnalyzer.AnalyseLine(var Line: string; var Status: TTestStatus): Boolean;
 
 Var
   TS : TTestStatus;
@@ -211,7 +173,7 @@ ConfigAddCols : Array [TConfigAddOpt] of string = (
 const
    SeparationLine = '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>';
 
-Function TDBDigestAnalyzer.GetContentsFromLongLog(Line : String) : String;
+function TDBDigestAnalyzer.GetContentsFromLongLog(Line: String): String;
 
   Function GetLongLogLine : String;
   begin
@@ -269,7 +231,7 @@ begin
     end;
 end;
 
-Function TDBDigestAnalyzer.GetLog(Line, FN : String) : String;
+function TDBDigestAnalyzer.GetLog(Line, FN: String): String;
 
 begin
   if UseLongLog then
@@ -311,119 +273,111 @@ begin
     end;
 end;
 
-procedure TDBDigestAnalyzer.Processfile(const aFileName: String; const aData: TTestRunData);
+function TDBDigestAnalyzer.SaveTestResult(aResult : TTestResultData) : Boolean;
+
+var
+  lLast : TTestResultData;
+  lNewID : Int64;
+
+begin
+  lLast:=FDB.GetLastTestResult(aResult.TestID,aResult.PlatformID);
+  if aResult.Differs(lLast) then
+    begin
+    // Need to save
+    lNewID:=FDB.AddTestResult(aResult)
+    end
+  else
+    // Update status, testrun & log
+    FDB.UpdateTestResult(aResult);
+end;
+
+procedure TDBDigestAnalyzer.Processfile(const aFileName: String; var aData: TTestRunData);
 
 var
-  logfile : text;
+  logfile : TStrings;
   fullline,line,prevLine : string;
-  TS,PrevTS : TTestStatus;
-  ID,PrevID : integer;
+  TS : TTestStatus;
   Testlog : string;
   count_test : boolean;
+  lPrev,lResult : TTestResultData;
+
 begin
-  AssignFile(logfile,aFileName);
-  PrevId:=-1;
+  lPrev:=Default(TTestResultData);
+  // init data common to the whole testrun
+  lResult.RunID:=aData.RunID;
+  lResult.PlatFormID:=aData.PlatFormID;
+  lPrev.RunID:=aData.RunID;
+  lPrev.PlatformID:=aData.PlatformID;
+  lPrev.TestID:=-1; // Init no test
   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
+  logfile:=TStringList.Create;
+  try
+    LogFile.Capacity:=20000;
+    LogFile.LoadFromFile(aFileName);
+    For FullLine in LogFile do
       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
+        lResult:=Default(TTestResultData);
+        line:=fullline;
+        lResult.TestResult:=stFailedToCompile;
+        If not AnalyseLine(line,TS) 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
+          Inc(UnknownLines);
+          Verbose(V_Warning,'Unknown line: "'+line+'"');
+          end
+        else
           begin
-          If Not (TestOK[TS] or TestSkipped[TS]) then
+          Verbose(V_NORMAL,'Analysing result for test '+Line);
+          lResult.TestID:=FDB.RequireTestID(line);
+          if lResult.TestID=-1 then
+            begin
+            Verbose(V_Warning,'No test ID: "'+line+'", skipping');
+            Continue;
+            end;
+          If ExpectRun[TS] then
             begin
-              TestLog:=GetExecuteLog(Fullline,Line);
-              if pos(failed_to_compile,TestLog)=1 then
-                TestLog:=GetLog(Fullline,Line);
+            // We expect a log line with log result, save
+            Inc(aData.StatusCount[TS]);
+            lPrev.TestResult:=TS;
+            lPrev.TestID:=lResult.TestID;
+            PrevLine:=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])
+            // New test, insert previous result
+            if (lPrev.TestID<>-1) and (lPrev.TestID<>lResult.TestID) then
+              begin
+              { This can only happen if a Successfully compiled message
+                is not followed by any other line about the same test }
+              SaveTestResult(lPrev);
+              Verbose(V_Warning,'Orphaned test: "'+prevline+'"');
+              end;
+            // same test, so now we have run result
+            lPrev.TestID:=-1;
+            lResult.TestResult:=TS;
+            If (lResult.TestID<>-1) then
+              begin
+              If Not (TestOK[TS] or TestSkipped[TS]) then
+                begin
+                  lResult.Log:=GetExecuteLog(Fullline,Line);
+                  if pos(failed_to_compile,lResult.Log)=1 then
+                    lResult.Log:=GetLog(Fullline,Line);
+                end
               else
-                Verbose(V_Debug,'Test: "'+line+'" was updated');
+                lResult.Log:='';
+              SaveTestResult(lResult);
+              end;
             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;
-    end;
-  close(logfile);
+  finally
+    Logfile.Free;
+  end;
 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);
+  FDB.UpdateTestRun(aData);
 end;
 
 

tests/utils/tests.sql

@@ -101,6 +101,7 @@ CREATE TABLE TESTCPU (
 
 INSERT INTO TESTCATEGORY VALUES (1, 'Compiler/RTL');
 INSERT INTO TESTCATEGORY VALUES (2, 'DB');
+ALTER SEQUENCE SEQ_TESTCATEGORY RESTART WITH 3;
 
 INSERT INTO TESTCPU VALUES (1, 'i386');
 INSERT INTO TESTCPU VALUES (6, 'arm');
@@ -110,6 +111,14 @@ INSERT INTO TESTCPU VALUES (5, 'powerpc');
 INSERT INTO TESTCPU VALUES (7, 'x86_64');
 INSERT INTO TESTCPU VALUES (8, 'All');
 INSERT INTO TESTCPU VALUES (9, 'powerpc64');
+INSERT INTO TESTCPU VALUES (10, 'wasm32');
+INSERT INTO TESTCPU VALUES (11, 'longsoon');
+INSERT INTO TESTCPU VALUES (12, 'longsoon64');
+INSERT INTO TESTCPU VALUES (13, 'mips');
+INSERT INTO TESTCPU VALUES (14, 'mips64');
+INSERT INTO TESTCPU VALUES (15, 'avr');
+INSERT INTO TESTCPU VALUES (16, 'xtensa');
+ALTER SEQUENCE SEQ_TESTCPU RESTART WITH 17;
 
 INSERT INTO TESTOS VALUES (1, 'linux');
 INSERT INTO TESTOS VALUES (2, 'win32');
@@ -128,6 +137,8 @@ INSERT INTO TESTOS VALUES (14, 'macos');
 INSERT INTO TESTOS VALUES (15, 'All');
 INSERT INTO TESTOS VALUES (16, 'win64');
 INSERT INTO TESTOS VALUES (17, 'wince');
+INSERT INTO TESTOS VALUES (18, 'wasi');
+ALTER SEQUENCE SEQ_TESTOS RESTART WITH 19;
 
 INSERT INTO TESTVERSION VALUES (1, '2.0.4', '2006-08-22 22:38:20');
 INSERT INTO TESTVERSION VALUES (2, '2.0.5', '2006-08-22 22:38:20');
@@ -135,4 +146,6 @@ INSERT INTO TESTVERSION VALUES (3, '2.3.1', '2007-03-04 23:40:07');
 INSERT INTO TESTVERSION VALUES (4, '2.1.2', '2007-03-19 10:49:30');
 INSERT INTO TESTVERSION VALUES (5, '2.1.3', '2007-03-19 10:49:47');
 INSERT INTO TESTVERSION VALUES (6, '2.1.4', '2007-03-19 10:50:03');
-
+INSERT INTO TESTVERSION VALUES (7, '3.2.2', '2020-04-01 10:50:03');
+INSERT INTO TESTVERSION VALUES (8, '3.3.1', '2020-04-01 10:50:03');
+ALTER SEQUENCE SEQ_TESTVERSION RESTART WITH 9;

tests/utils/testsuite.sql

@@ -12,7 +12,7 @@ CREATE DATABASE testsuite
     CONNECTION LIMIT = -1
     IS_TEMPLATE = False;
 
-CREATE SEQUENCE SEQ_TESTCATEGORY;
+CREATE SEQUENCE SEQ_TESTCATEGORY as INT start with 1;
 
 CREATE TABLE TESTCATEGORY (
   TA_ID INT NOT NULL DEFAULT nextval('SEQ_TESTCATEGORY'),
@@ -22,7 +22,7 @@ CREATE TABLE TESTCATEGORY (
 
 CREATE UNIQUE INDEX UDX_TESTCATEGORYNAME ON TESTCATEGORY(TA_NAME);
 
-CREATE SEQUENCE SEQ_TESTCPU;
+CREATE SEQUENCE SEQ_TESTCPU as INT start with 1;
 
 CREATE TABLE TESTCPU (
   TC_ID INT NOT NULL DEFAULT nextval('SEQ_TESTCPU'),
@@ -32,7 +32,7 @@ CREATE TABLE TESTCPU (
 
 CREATE UNIQUE INDEX UDX_TESTCPU ON TESTCPU(TC_NAME);
 
-CREATE SEQUENCE SEQ_TESTOS;
+CREATE SEQUENCE SEQ_TESTOS as INT start with 1;
 
 CREATE TABLE TESTOS (
   TO_ID INT DEFAULT nextval('SEQ_TESTOS'),
@@ -42,7 +42,7 @@ CREATE TABLE TESTOS (
 
 CREATE UNIQUE INDEX UDX_TESTOS ON TESTOS(TO_NAME);
 
-CREATE SEQUENCE SEQ_TESTVERSION;
+CREATE SEQUENCE SEQ_TESTVERSION as INT start with 1;
 
 CREATE TABLE TESTVERSION (
   TV_ID int NOT NULL default nextval('SEQ_TESTVERSION'),
@@ -53,7 +53,7 @@ CREATE TABLE TESTVERSION (
 
 CREATE UNIQUE INDEX UDX_TESTVERSION ON TESTVERSION(TV_VERSION);
 
-CREATE SEQUENCE SEQ_TESTS;
+CREATE SEQUENCE SEQ_TESTS as INT start with 1;
 
 CREATE TABLE TESTS (
   T_ID int NOT NULL default nextval('SEQ_TESTS'),
@@ -80,7 +80,7 @@ CREATE TABLE TESTS (
 
 CREATE UNIQUE INDEX UDX_TESTS ON TESTS(T_NAME);
 
-CREATE SEQUENCE SEQ_TESTPLATFORM;
+CREATE SEQUENCE SEQ_TESTPLATFORM as INT start with 1;
 
 CREATE TABLE TESTPLATFORM (
   TP_ID INT NOT NULL default nextval('SEQ_TESTPLATFORM'),
@@ -89,19 +89,26 @@ CREATE TABLE TESTPLATFORM (
   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 UNIQUE INDEX UDX_TESTPLATFORM ON TESTPLATFORM(TP_CPU_FK,TP_OS_FK,TP_VERSION_FK,TP_CATEGORY_FK,TP_CONFIG);
 CREATE INDEX IDX_TESTPLATFORMRELATIONS ON TESTPLATFORM(TP_CPU_FK,TP_OS_FK,TP_VERSION_FK,TP_CATEGORY_FK);
 
-CREATE SEQUENCE SEQ_TESTRUN;
+CREATE SEQUENCE SEQ_TESTRUN as BIGINT start with 1;
 
 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_MACHINE VARCHAR(127) NOT NULL,
+  TU_COMPILERDATE VARCHAR(15),
+  TU_COMPILERFULLVERSION VARCHAR(50),
+  TU_COMPILERREVISION VARCHAR(50),
+  TU_TESTSREVISION VARCHAR(50),
+  TU_RTLREVISION VARCHAR(50),
+  TU_PACKAGESREVISION VARCHAR(50),
+  TU_SUBMITTER varchar(128) NOT NULL default '',
   TU_FAILEDTOCOMPILE int NOT NULL default 0,
   TU_SUCCESSFULLYFAILED int NOT NULL default 0,
   TU_FAILEDTOFAIL int NOT NULL default 0,
@@ -118,7 +125,40 @@ CREATE TABLE TESTRUN (
   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)
 );
-    
+
+CREATE UNIQUE INDEX UDX_TESTRUN ON TESTRUN(TU_DATE,TU_PLATFORM_FK);
+CREATE INDEX IDX_TESTRUNPLATFORM ON TESTRUN(TU_PLATFORM_FK,TU_DATE);
+
+CREATE SEQUENCE SEQ_TESTRESULTS as BIGINT start with 1;
+
+CREATE TABLE TESTRESULTS (
+  TR_ID bigint NOT NULL default nextval('SEQ_TESTRESULTS'),
+  TR_TESTRUN_FK bigint NOT NULL default 0,
+  TR_TEST_FK int not NULL,
+  TR_OK Boolean NOT NULL default 'f',
+  TR_SKIP boolean NOT NULL default 'f',
+  TR_RESULT int NOT NULL default 0,
+  TR_LOG text,
+  constraint PK_TESTRESULTS PRIMARY KEY (TR_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTRESULTS ON TESTRESULTS (TR_TESTRUN_FK,TR_TEST_FK);
+
+CREATE TABLE TESTLASTRESULTS (
+  TL_TEST_FK int not NULL,
+  TL_PLATFORM_FK int not NULL,
+  TL_TESTRESULTS_FK bigint NOT NULL
+);
+
+CREATE UNIQUE INDEX UDX_TESTLASTRESULTS ON TESTLASTRESULTS(TL_PLATFORM_FK,TL_TEST_FK);
+
+CREATE TABLE TESTPREVIOUSRESULTS (
+  TPR_TEST_FK int not NULL,
+  TPR_PLATFORM_FK int not NULL,
+  TPR_TESTRESULTS_FK bigint NOT NULL
+);
+
+CREATE UNIQUE INDEX UDX_TESTPREVIOUSRESULTS ON TESTPREVIOUSRESULTS(TPR_PLATFORM_FK,TPR_TEST_FK);
+

tests/utils/testu.pp

@@ -1,4 +1,5 @@
 {$mode objfpc}
+{$modeswitch advancedrecords}
 {$h+}
 
 unit testu;
@@ -6,7 +7,7 @@ unit testu;
 Interface
 
 uses
-  dos;
+  classes, sysutils, tresults;
 { ---------------------------------------------------------------------
     utility functions, shared by several programs of the test suite
   ---------------------------------------------------------------------}
@@ -53,6 +54,48 @@ type
     ExpectMsgs    : array of longint;
   end;
 
+  // Test run data
+  TTestRunData = Record
+    logfile: string;
+    longlogfile : string;
+    os: string;
+    cpu: string;
+    category: string;
+    version: string;
+    submitter: string;
+    machine: string;
+    config : string;
+    description : string;
+    Date : TDateTime;
+    CompilerDate,
+    CompilerFullVersion,
+    CompilerRevision,
+    TestsRevision,
+    RTLRevision,
+    PackagesRevision : String;
+    CPUID : Integer;
+    OSID  : Integer;
+    VersionID  : Integer;
+    CategoryID : Integer;
+    RunID : Int64;
+    //ConfigID : Integer;
+    PlatformID : Integer;
+    StatusCount : Array[TTestStatus] of Integer;
+  end;
+
+  { TTestResultData }
+
+  TTestResultData = record
+    PlatformID : Integer;
+    TestID : Integer;
+    ID : Int64;
+    RunID : Int64;
+    TestResult : TTestStatus;
+    Log : String;
+    function Differs(aResult : TTestResultData; CompareLog : Boolean = False) : Boolean;
+  end;
+
+
 Const
   DoVerbose : boolean = false;
   DoSQL     : boolean = false;
@@ -65,6 +108,7 @@ function upper(const s : string) : string;
 procedure Verbose(lvl:TVerboseLevel;const s:string);
 function GetConfig(const fn:string;var r:TConfig):boolean;
 Function GetFileContents (FN : String) : String;
+function GetUnitTestConfig(const fn,SrcDir: string; var r : TConfig) : Boolean;
 
 const
 { Constants used in IsAbsolute function }
@@ -86,6 +130,16 @@ function GetToken(var s: string; Delims: TCharSet = [' ']):string;
 
 Implementation
 
+function posr(c : Char; const s : AnsiString) : integer;
+var
+  i : integer;
+begin
+  i := length(s);
+  while (i>0) and (s[i] <> c) do dec(i);
+  Result := i;
+end;
+
+
 function GetToken(var s: string; Delims: TCharSet = [' ']):string;
 var
   i : longint;
@@ -125,46 +179,27 @@ begin
 end;
 
 Function SplitFileName(const s:string):string;
-var
-  p : dirstr;
-  n : namestr;
-  e : extstr;
+
 begin
-  FSplit(s,p,n,e);
-  SplitFileName:=n+e;
+  Result:=ExtractFileName(S);
 end;
 
 Function SplitFileBase(const s:string):string;
-var
-  p : dirstr;
-  n : namestr;
-  e : extstr;
+
 begin
-  FSplit(s,p,n,e);
-  SplitFileBase:=n;
+  Result:=ChangeFileExt(ExtractFileName(S),'');
 end;
 
 Function SplitFileExt(const s:string):string;
-var
-  p : dirstr;
-  n : namestr;
-  e : extstr;
 begin
-  FSplit(s,p,n,e);
-  SplitFileExt:=e;
+  Result:=ExtractFileExt(S);
 end;
 
 
 Function FileExists (Const F : String) : Boolean;
-{
-  Returns True if the file exists, False if not.
-}
-Var
-  info : searchrec;
+
 begin
-  FindFirst (F,anyfile,Info);
-  FileExists:=DosError=0;
-  FindClose (Info);
+  Result:=SysUtils.FileExists(F);
 end;
 
 
@@ -172,12 +207,9 @@ Function PathExists (Const F : String) : Boolean;
 {
   Returns True if the file exists, False if not.
 }
-Var
-  info : searchrec;
+
 begin
-  FindFirst (F,anyfile,Info);
-  PathExists:=(DosError=0) and (Info.Attr and Directory=Directory);
-  FindClose (Info);
+  Result:=DirectoryExists(F);
 end;
 
 { extracted from rtl/macos/macutils.inc }
@@ -265,13 +297,14 @@ var
   i,l  : longint;
 
 begin
+  Result:='';
   L:=Length(S);
-  SetLength(upper,l);
+  SetLength(Result,l);
   for i:=1 to l do
     if s[i] in ['a'..'z'] then
-     upper[i]:=char(byte(s[i])-32)
+     Result[i]:=char(byte(s[i])-32)
     else
-     upper[i]:=s[i];
+     Result[i]:=s[i];
 end;
 
 function GetConfig(const fn:string;var r:TConfig):boolean;
@@ -280,7 +313,7 @@ var
   part,code : integer;
   l : longint;
   p : sizeint;
-  s,res,tmp : string;
+  s,res: string;
 
   function GetEntry(const entry:string):boolean;
   var
@@ -525,4 +558,81 @@ begin
   Close(F);
 end;
 
+function GetUnitTestConfig(const fn,SrcDir : string; var r : TConfig) : Boolean;
+
+var
+  Path       : string;
+  lClassName  : string;
+  lMethodName : string;
+  slashpos   : integer;
+  FileName   : string;
+  s,line     : string;
+  Src : TStrings;
+
+begin
+  Result := False;
+  FillChar(r,sizeof(r),0);
+  if pos('.',fn) > 0 then exit; // This is normally not a unit-test
+  slashpos := posr('/',fn);
+  if slashpos < 1 then exit;
+  lMethodName := copy(fn,slashpos+1,length(fn));
+  Path := copy(fn,1,slashpos-1);
+  slashpos := posr('/',Path);
+  if slashpos > 0 then
+    begin
+    lClassName := copy(Path,slashpos+1,length(Path));
+    Path := copy(Path,1,slashpos-1);
+    end
+  else
+    begin
+    lClassName := Path;
+    path := '.';
+    end;
+  if upper(lClassName[1])<>'T' then exit;
+  FileName := SrcDir+Path+DirectorySeparator+copy(lowercase(lClassName),2,length(lClassName));
+  if FileExists(FileName+'.pas') then
+    FileName := FileName + '.pas'
+  else if FileExists(FileName+'.pp') then
+    FileName := FileName + '.pp'
+  else
+    exit;
+  Src:=TStringList.Create;
+  try
+    Verbose(V_Debug,'Reading: '+FileName);
+    Src.LoadFromFile(FileName);
+    for Line in Src do
+      if Line<>'' then
+        begin
+        s:=Line;
+        TrimB(s);
+        if SameText(copy(s,1,9),'PROCEDURE') then
+          begin
+           if pos(';',s)>11 then
+            begin
+              s := copy(s,11,pos(';',s)-11);
+              TrimB(s);
+              if SameText(s,lClassName+'.'+lMethodName) then
+               begin
+                 Result := True;
+                 r.Note:= 'unittest';
+               end;
+            end;
+          end;
+        end;
+  finally
+    Src.Free
+  end;
+end;
+
+{ TTestResultData }
+
+function TTestResultData.Differs(aResult: TTestResultData; CompareLog: Boolean): Boolean;
+begin
+  Result:=(PlatformID<>aResult.PlatFormID);
+  Result:=Result or (TestID<>aResult.TestID);
+  Result:=Result or (TestResult<>aResult.TestResult);
+  if CompareLog and Not Result then
+    Result:=Log<>aResult.Log;
+end;
+
 end.

tests/utils/unittests/tcsetup.pas

@@ -0,0 +1,200 @@
+unit tcsetup;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, testdecorator, dbtests, sqldb, pqconnection;
+
+type
+  { TDBHelper }
+
+  TDBHelper = class
+    class var SQL : TTestSQL;
+    class var Conn : TPQConnection;
+    class function CreateQuery(const aSQL : String) : TSQLQuery;
+    class procedure setup;
+    class procedure ClearTable(const aTable : string);
+    class function IDQuery(const aSQL : String) : Int64;
+    class procedure ExecAndCommit(Qry: TSQLQuery);
+    class procedure ExecSQL(const aSQL: String);
+    class function CountRecords(const aTable : String; const aFilter : String = '') : Int64;
+    class procedure MaybeRollback;
+  end;
+  { TDBDecorator }
+
+  TDBDecorator = class(TTestSetup)
+  Public
+    procedure OneTimeSetup; override;
+    procedure OneTimeTearDown; override;
+  end;
+
+implementation
+
+uses inifiles;
+
+
+const
+  SDatabase   = 'Database';
+  KeyName     = 'Name';
+  KeyHost     = 'Host';
+  KeyUser     = 'UserName';
+  KeyPassword = 'Password';
+  KeyPort     = 'Port';
+
+{ TDBDecorator }
+
+class function TDBHelper.CreateQuery(const aSQL: String): TSQLQuery;
+begin
+  Result:=TSQLQuery.Create(Conn);
+  Result.DataBase:=Conn;
+  Result.Transaction:=Conn.Transaction;
+  Result.SQL.Text:=aSQL;
+end;
+
+class procedure TDBHelper.setup;
+
+var
+  Ini : TCustomIniFile;
+  lFileName,lName,lHost,lUser,lPassword: String;
+  lPort : Integer;
+
+begin
+  lFileName:=ExtractFilePath(Paramstr(0))+'testdigest.ini';
+  if not FileExists(lFileName) then
+    TAssert.Fail('No config filename %s',[lFileName]);
+  Ini:=TMemIniFile.Create(lFileName);
+  try
+    lName:=Ini.ReadString(SDatabase,KeyName,'');
+    if lName='testsuite' then
+      TAssert.Fail('As a precaution, test database cannot be called testsuite');
+    lHost:=Ini.ReadString(SDatabase,KeyHost,'');
+    lUser:=Ini.ReadString(SDatabase,KeyUser,'');
+    lPassword:=Ini.ReadString(SDatabase,KeyPassword,'');
+    lPort:=Ini.ReadInteger(SDatabase,KeyPort,0);
+  finally
+    Ini.Free;
+  end;
+  SQL:=TTestSQL.create(lName,lHost,lUser,lPassword,lPort);
+  if not SQL.ConnectToDatabase then
+    TAssert.Fail('Could not connect to database');
+  Conn:=TPQConnection.Create(Nil);
+  Conn.DatabaseName:=lName;
+  Conn.HostName:=lHost;
+  Conn.UserName:=lUser;
+  Conn.Password:=lPassword;
+  if lPort<>0 then
+    Conn.Params.values['port']:=IntToStr(lPort);
+  conn.Transaction:=TSQLTransaction.Create(Conn);
+  conn.Connected:=True;
+  (*
+  l:=TStringList.Create;
+  try
+    conn.GetTableNames(l);
+    writeln('Tables:');
+    Writeln('-------');
+    Writeln(l.text);
+    Writeln('-------');
+
+
+  finally
+    l.Free
+  end;
+  *)
+end;
+
+class procedure TDBHelper.ExecAndCommit(Qry : TSQLQuery);
+
+begin
+  if not Qry.SQLTransaction.Active then
+    Qry.SQLTransaction.StartTransaction;
+  try
+    Qry.ExecSQL;
+    if Qry.SQLTransaction.Active then
+      Qry.SQLTransaction.Commit;
+  except
+    if Qry.SQLTransaction.Active then
+      Qry.SQLTransaction.RollBack;
+    Raise;
+  end;
+end;
+
+class procedure TDBHelper.ExecSQL(const aSQL : String);
+
+var
+  Qry : TSQLQuery;
+begin
+  // Truncate would be faster, but we have foreign keys
+  Qry:=CreateQuery(aSQL);
+  try
+    ExecAndCommit(Qry);
+  finally
+    Qry.Free;
+  end;
+end;
+
+class function TDBHelper.CountRecords(const aTable: String; const aFilter: String): Int64;
+var
+  lSQL : String;
+begin
+  lSQL:='select count(*) as thecount from '+aTable;
+  if aFilter<>'' then
+    lSQL:=lSQL+' where '+aFilter;
+  Result:=IDQuery(lSQL);
+end;
+
+class procedure TDBHelper.MaybeRollback;
+begin
+  if Assigned(Conn) and Assigned(Conn.Transaction) and Conn.Transaction.Active then
+    Conn.Transaction.RollBack;
+end;
+
+class procedure TDBHelper.ClearTable(const aTable: string);
+
+begin
+  // Truncate would be faster, but we have foreign keys
+  ExecSQL('delete from '+aTable);
+end;
+
+class function TDBHelper.IDQuery(const aSQL: String): Int64;
+
+var
+  Qry : TSQLQuery;
+
+begin
+  Qry:=CreateQuery(aSQL);
+  try
+    if not Qry.SQLTransaction.Active then
+      Qry.SQLTransaction.StartTransaction;
+    try
+      Qry.Open;
+      Result:=Qry.Fields[0].AsLargeInt;
+      if Qry.SQLTransaction.Active then
+        Qry.SQLTransaction.Commit;
+    except
+      if Qry.SQLTransaction.Active then
+        Qry.SQLTransaction.RollBack;
+      Raise;
+    end;
+  finally
+    Qry.Free;
+  end;
+end;
+
+
+procedure TDBDecorator.OneTimeSetup;
+
+begin
+  TDBHelper.Setup;
+end;
+
+procedure TDBDecorator.OneTimeTearDown;
+begin
+  FreeAndNil(TDBHelper.SQL);
+  FreeAndNil(TDBHelper.Conn);
+end;
+
+
+end.
+

tests/utils/unittests/tctestsql.pas

@@ -0,0 +1,488 @@
+unit tctestsql;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, testu, dbtests, tresults, sqldb, pqconnection;
+
+const
+  Bools : Array[Boolean] of string = ('f','t');
+
+type
+
+
+  { TTestSQLCase }
+
+  TTestSQLCase= class(TTestCase)
+  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
+    procedure SetUp; override;
+    procedure TearDown; override;
+    procedure CreateSource(const aFileName : String);
+    property SQL : TTestSQL Read GetSQL;
+  published
+    procedure TestHookUp;
+    procedure TestAddCPU;
+    procedure TestAddOS;
+    procedure TestAddVersion;
+    procedure TestAddCategory;
+    procedure TestAddTest;
+    procedure TestAddPlatform;
+    Procedure TestAddRun;
+    procedure TestUpdateRun;
+    Procedure TestAddTestResult;
+    Procedure TestAddTestResultTwice;
+    Procedure TestUpdateTestResult;
+    Procedure TestAddLastResult;
+    Procedure TestAddLastResultTwice;
+    Procedure TestGetLastTestResult;
+    procedure TestGetCPUID;
+    procedure TestGetOSID;
+    procedure TestGetCategoryID;
+    procedure TestGetVersionID;
+    procedure TestGetTestID;
+    procedure TestGetRunID;
+  end;
+
+
+
+implementation
+
+uses tcsetup;
+
+procedure TTestSQLCase.TestHookUp;
+begin
+  AssertEquals('Empty testos',0,TDBHelper.CountRecords('TESTOS'));
+  AssertEquals('Empty TESTCPU',0,TDBHelper.CountRecords('TESTCPU'));
+  AssertEquals('Empty TESTCATEGORY',0,TDBHelper.CountRecords('TESTCATEGORY'));
+  AssertEquals('Empty TESTVERSION',0,TDBHelper.CountRecords('TESTVERSION'));
+  AssertEquals('Empty TESTPLATFORM',0,TDBHelper.CountRecords('TESTPLATFORM'));
+  AssertEquals('Empty TESTRUN',0,TDBHelper.CountRecords('TESTRUN'));
+  AssertEquals('Empty TESTS',0,TDBHelper.CountRecords('TESTS'));
+  AssertEquals('Empty TESTRESULTS',0,TDBHelper.CountRecords('TESTRESULTS'));
+  AssertEquals('Empty TESTLASTRESULTS',0,TDBHelper.CountRecords('TESTLASTRESULTS'));
+  AssertEquals('Empty TESTPREVIOUSRESULTS',0,TDBHelper.CountRecords('TESTPREVIOUSRESULTS'));
+end;
+
+procedure TTestSQLCase.TestAddCPU;
+var
+  lID : Int64;
+begin
+  lID:=SQL.AddCPU('x');
+  AssertEquals('exists',1,TDBHelper.CountRecords('TESTCPU',Format('(TC_ID=%d) and (tc_name=''x'')',[lID])));
+end;
+
+procedure TTestSQLCase.TestAddOS;
+var
+  lID : Int64;
+begin
+  lID:=SQL.AddOS('x');
+  AssertEquals('exists',1,TDBHelper.CountRecords('TESTOS',Format('(TO_ID=%d) and (to_name=''x'')',[lID])));
+end;
+
+procedure TTestSQLCase.TestAddVersion;
+var
+  lID : Int64;
+begin
+  lID:=SQL.AddVersion('x',date);
+  AssertEquals('exists',1,TDBHelper.CountRecords('TESTVERSION',Format('(Tv_ID=%d) and (tv_version=''x'')',[lID])));
+end;
+
+procedure TTestSQLCase.TestAddCategory;
+var
+  lID : Int64;
+begin
+  lID:=SQL.AddCategory('x');
+  AssertEquals('exists',1,TDBHelper.CountRecords('TESTCATEGORY',Format('(TA_ID=%d) and (ta_name=''x'')',[lID])));
+end;
+
+procedure TTestSQLCase.TestAddTest;
+var
+  lID : Integer;
+begin
+  CreateSource('x');
+  lID:=SQL.AddTest('x.pp',False);
+  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;
+
+const
+  SQLFilter = '(TP_ID=%d) and (TP_OS_FK=%d) and (TP_CPU_FK=%d) '+
+              'and (TP_VERSION_FK=%d) and (TP_CONFIG=''%s'')';
+var
+  lData : TTestRunData;
+  lID : integer;
+  Flt : String;
+begin
+  lData:=Default(TTestRunData);
+  lID:=PreparePlatform(lData);
+  With lData do
+    flt:=Format(SQLFilter,[lID,OSID,CPUID,VersionID,Config]);
+  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
+  lData : TTestRunData;
+  lID : Int64;
+  Qry : TSQLQuery;
+
+begin
+  lData:=Default(TTestRunData);
+  lData.PlatformID:=PreparePlatform(lData);
+  With lData do
+    begin
+    machine:='a';
+    submitter:='b';
+    description:='c';
+    Date:=Sysutils.Date;
+    CompilerDate:='ymd';
+    CompilerFullVersion:='1.2';
+    CompilerRevision:='1.3';
+    TestsRevision:='1.4';
+    RTLRevision:='1.5';
+    PackagesRevision:='1.6';
+    end;
+  lID:=SQL.AddRun(lData);
+  Qry:=TDBHelper.CreateQuery(Format('Select * from testrun where (tu_id=%d)',[lID]));
+  try
+    Qry.Open;
+    AssertFalse('Have data',Qry.IsEmpty);
+    AssertTestRunData(Qry,lData);
+  finally
+    Qry.Free;
+  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;
+
+var
+  lData : TTestRunData;
+  lResult : TTestResultData;
+  lID : Int64;
+  flt : String;
+  OK,Skip : Boolean;
+
+begin
+  lID:=CreateResultData(lData,lResult);
+  OK:=TestOK[lResult.TestResult];
+  Skip:=TestSkipped[lResult.TestResult];
+  With lResult do
+    flt:=Format(SQLTestResultFilter,[lID,RunID,TestID,Bools[OK],Bools[Skip],Ord(TestResult),Log]);
+  AssertEquals('Platform',1,TDBHelper.CountRecords('TESTRESULTS',Flt));
+end;
+
+procedure TTestSQLCase.TestAddTestResultTwice;
+var
+  lData : TTestRunData;
+  lResult : TTestResultData;
+  lID,lID2 : Int64;
+  flt : String;
+  OK,Skip : Boolean;
+
+begin
+  CreateResultData(lData,lResult);
+  OK:=TestOK[lResult.TestResult];
+  Skip:=TestSkipped[lResult.TestResult];
+  lID:=SQL.AddTestResult(lResult);
+  // Change result
+  lResult.TestResult:=stFailedToCompile;
+  lResult.Log:='xyza';
+  OK:=TestOK[lResult.TestResult];
+  Skip:=TestSkipped[lResult.TestResult];
+  // Insert again...
+  lID2:=SQL.AddTestResult(lResult);
+  AssertEquals('Same ID',lID,lID2);
+  flt:=Format(SQLTestResultFilter,[lID,lResult.RunID,lResult.TestID,Bools[OK],Bools[Skip],Ord(lResult.TestResult),lResult.Log]);
+  AssertEquals('Result',1,TDBHelper.CountRecords('TESTRESULTS',Flt));
+end;
+
+procedure TTestSQLCase.TestUpdateTestResult;
+var
+  lData : TTestRunData;
+  lResult : TTestResultData;
+  lID2,lID : Int64;
+  flt : String;
+  OK,Skip : Boolean;
+
+begin
+  lID:=CreateResultData(lData,lResult);
+  // Change result
+  lResult.ID:=lID;
+  lResult.TestResult:=stFailedToCompile;
+  lResult.Log:='xyza';
+  OK:=TestOK[lResult.TestResult];
+  Skip:=TestSkipped[lResult.TestResult];
+  // Update
+  lID2:=SQL.UpdateTestResult(lResult);
+  AssertEquals('Same ID',lID,lID2);
+  flt:=Format(SQLTestResultFilter,[lID,lResult.RunID,lResult.TestID,Bools[OK],Bools[Skip],Ord(lResult.TestResult),lResult.Log]);
+  AssertEquals('Result',1,TDBHelper.CountRecords('TESTRESULTS',Flt));
+end;
+
+procedure TTestSQLCase.TestAddLastResult;
+
+var
+  lData : TTestRunData;
+  lResult : TTestResultData;
+  lID : Int64;
+  flt : String;
+
+begin
+  lID:=CreateResultData(lData,lResult);
+  AssertTrue('Add',SQL.AddLastResult(lResult.TestID,lData.PlatformID,lID));
+  flt:=Format('(TL_TEST_FK=%d) and (TL_PLATFORM_FK=%d) and (TL_TESTRESULTS_FK=%d)',[lResult.TestID,lData.PlatformID,lID]);
+  AssertEquals('Result',1,TDBHelper.CountRecords('TESTLASTRESULTS',Flt));
+end;
+
+procedure TTestSQLCase.TestAddLastResultTwice;
+var
+  lData : TTestRunData;
+  lResult : TTestResultData;
+  lID,lID2 : Integer;
+  flt : string;
+begin
+  lID:=CreateResultData(lData,lResult,1);
+  AssertTrue('Add',SQL.AddLastResult(lResult.TestID,lData.PlatformID,lID));
+  lID2:=CreateResultData(lData,lResult,0);
+  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;
+var
+  lData : TTestRunData;
+  lResult2,lResult : TTestResultData;
+  lID : Integer;
+begin
+  lID:=CreateResultData(lData,lResult);
+  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);
+end;
+
+procedure TTestSQLCase.TestUpdateRun;
+
+var
+  lData : TTestRunData;
+  St : TTestStatus;
+  Qry : TSQLQuery;
+
+begin
+  lData:=Default(TTestRunData);
+  lData.PlatformID:=PreparePlatform(lData);
+  lData.RunID:=SQL.AddRun(lData);
+  for St in TTestStatus do
+    lData.StatusCount[st]:=(Ord(st)+1)*100;
+  AssertTrue('Update',SQL.UpdateTestRun(lData));
+  Qry:=TDBHelper.CreateQuery(Format('Select * from testrun where (tu_id=%d)',[lData.RunID]));
+  try
+    Qry.Open;
+    AssertFalse('Have data',Qry.IsEmpty);
+    AssertTestRunData(Qry,lData);
+  finally
+    Qry.Free;
+  end;
+end;
+
+procedure TTestSQLCase.TestGetCPUID;
+begin
+  TDBHelper.ExecSQL('INSERT INTO TESTCPU VALUES (1,''x'')');
+  TDBHelper.ExecSQL('INSERT INTO TESTCPU VALUES (2,''y'')');
+  AssertEquals('Count',2,TDBHelper.CountRecords('TESTCPU'));
+  AssertEquals('Get x',1,SQL.GetCPUID('x'));
+  AssertEquals('Get y',2,SQL.GetCPUID('y'));
+  AssertEquals('Get z',-1,SQL.GetCPUID('z'));
+end;
+
+procedure TTestSQLCase.TestGetOSID;
+
+begin
+  TDBHelper.ExecSQL('INSERT INTO TESTOS VALUES (1,''x'')');
+  TDBHelper.ExecSQL('INSERT INTO TESTOS VALUES (2,''y'')');
+  AssertEquals('Count',2,TDBHelper.CountRecords('TESTOS'));
+  AssertEquals('Get x',1,SQL.GetOSID('x'));
+  AssertEquals('Get y',2,SQL.GetOSID('y'));
+  AssertEquals('Get z',-1,SQL.GetOSID('z'));
+end;
+
+procedure TTestSQLCase.TestGetCategoryID;
+begin
+  TDBHelper.ExecSQL('INSERT INTO TESTCategory VALUES (1,''x'')');
+  TDBHelper.ExecSQL('INSERT INTO TESTCategory VALUES (2,''y'')');
+  AssertEquals('Count',2,TDBHelper.CountRecords('TESTCategory'));
+  AssertEquals('Get x',1,SQL.GetCategoryID('x'));
+  AssertEquals('Get y',2,SQL.GetCategoryID('y'));
+  AssertEquals('Get z',-1,SQL.GetCategoryID('z'));
+end;
+
+procedure TTestSQLCase.TestGetVersionID;
+begin
+  TDBHelper.ExecSQL('INSERT INTO TESTVERSION (TV_ID,TV_VERSION) VALUES (1,''x'')');
+  TDBHelper.ExecSQL('INSERT INTO TESTVERSION (TV_ID,TV_VERSION) VALUES (2,''y'')');
+  AssertEquals('Count',2,TDBHelper.CountRecords('TESTVERSION'));
+  AssertEquals('Get x',1,SQL.GetVersionID('x'));
+  AssertEquals('Get y',2,SQL.GetVersionID('y'));
+  AssertEquals('Get z',-1,SQL.GetVersionID('z'));
+end;
+
+procedure TTestSQLCase.TestGetTestID;
+begin
+  TDBHelper.ExecSQL('INSERT INTO TESTS (T_ID,T_NAME,T_ADDDATE) VALUES (1,''x.pp'',CURRENT_TIMESTAMP)');
+  TDBHelper.ExecSQL('INSERT INTO TESTS (T_ID,T_NAME,T_ADDDATE) VALUES (2,''y.pp'',CURRENT_TIMESTAMP)');
+  AssertEquals('Count',2,TDBHelper.CountRecords('TESTS'));
+  AssertEquals('Get x',1,SQL.GetTestID('x.pp'));
+  AssertEquals('Get y',2,SQL.GetTestID('y.pp'));
+  AssertEquals('Get z',-1,SQL.GetCategoryID('z.pp'));
+end;
+
+procedure TTestSQLCase.TestGetRunID;
+
+var
+  lData : TTestRunData;
+  lPlatformID : integer;
+  lRunID : Int64;
+begin
+  lData:=Default(TTestRunData);
+  lPlatformID:=PreparePlatform(lData);
+  lData.PlatformID:=lPlatFormID;
+  lData.Date:=Date;
+  lRunID:=SQL.AddRun(lData);
+  AssertEquals('Get run id',lRunID,SQL.GetRunID(lData));
+end;
+
+function TTestSQLCase.GetSQL: TTestSQL;
+begin
+  Result:=TDBHelper.SQL;
+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');
+  SQL.TestSrcDir:='./';
+end;
+
+procedure TTestSQLCase.TearDown;
+begin
+  TDBHelper.MaybeRollback;
+  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
+  RegisterTestDecorator(TDBDecorator,TTestSQLCase);
+
+end.
+

tests/utils/unittests/testdbdigest.lpi

@@ -0,0 +1,78 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="testdbdigest"/>
+      <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>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="FCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="testdbdigest.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="tctestsql.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../dbtests.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="tcsetup.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../digestanalyst.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testdbdigest"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value=".."/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

tests/utils/unittests/testdbdigest.lpr

@@ -0,0 +1,28 @@
+program testdbdigest;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, tctestsql, dbtests, digestanalyst, tcsetup;
+
+type
+
+  { TMyTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+  // override the protected methods of TTestRunner to customize its behavior
+  end;
+
+var
+  Application: TMyTestRunner;
+
+begin
+  DefaultRunAllTests:=True;
+  DefaultFormat:=fPlain;
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'FPCUnit Console test runner';
+  Application.Run;
+  Application.Free;
+end.

tests/utils/unittests/testdigest-sample.ini

@@ -0,0 +1,5 @@
+[Database]
+Name=testsuitetest
+host=localhost
+username=me
+password=secret