* Rework testsuite

tests/utils/README.md

@@ -0,0 +1,124 @@
+# DBDigest tool.
+
+## Configuration
+
+There are 2 kinds of configuration data for DBDigest.
+- global configuration
+- Test run data
+
+### Global configuration
+This includes database configuration and run mode.
+the database configuration can be specified in 3 different ways: 
+- in the global `/etc/dbdigest.ini`
+- the `dbigest.cfg` run file (deprecated)
+- the command-line. (deprecated)
+
+The global file is read first, if it exists. The `dbdigest.cfg` file is read
+next, and the command-line options are list:
+
+The recommended way is to put it in the global config file, which has the
+following format (the values are examples):
+```ini
+[Database]
+Name=testsuite
+Host=localhost
+username=user
+password=secret
+port=5432
+```
+In the 'dbdigest.cfg' file, the format is backwards-compatible:
+```text
+databasename=NAME
+host=HOST
+password=PWD
+username=USER
+```
+On the command-line the options are:
+```
+  -d --databasename=NAME            database name
+  -h --host=HOST                    database hostname
+  -p --password=PWD                 database user password
+  -P --port=NNN                     database connection port
+  -u --username=USER                database user name
+```
+Other than the database connection, the following global options can be
+given:
+- `-r --relsrcdir=DIR` the relative source dir for getting test files.
+- `-S --testsrcdir=DIR` the absolute test source dir
+- `-T --threadlist=FILE`  file with configuration file names to import.
+- `-j --threadcount=N` Maximum number of threads to use when importing.
+- `-V --verbose` be more verbose (writes lots of debug info)
+- `-f --config=FILENAME` in case a single digest file is imported, the name of the config file. 
+    If not set, dbdigest.cfg is used.
+
+If the -T --threadlist option is given, then -f/--config is ignored: no
+default file will be read. Only the files in the threadlist file will be
+treated.
+
+Example of a thread list file:
+```
+2025-05-01-i386/gcc-dbdigest.cfg
+2025-05-01-arm/llvm-dbdigest.cfg
+```
+The `logfile` and `longlogfile` will be treated as relative to the dbdigest.cfg files
+if they are relative filenames. If they are absolute filenames, they're used
+as-is.
+
+### Test Run data
+Run data describes one test run: basically, one dbdigest.cfg.
+For a single test run, the dbdigest.cfg file is read and the command-line
+options are examined to compose all data for a test run.
+- `-l --logfile=FILE` set log file to analyse
+- `-L --longlogfile=FILE` set long log filename (logs of run tests)
+- `-o --os=OS` set OS for testrun
+- `-c --cpu=CPU` set CPU
+- `-a --category=CAT` set category
+- `-v --version=VER` set compiler version
+- `-t --date=DATE` date in YYYMMDD(hhmmnn) format (only the date part is retained)
+- `-s --submitter=NAME` submitter name
+- `-m --machine=NAME` set machine name on which testsuite was run
+- `-C --compile-flags=FLAGS` set used compilation flags
+- `   --comment=FLAGS` backwards compatible way to set compilation flags (deprecated)
+- `-D --description=DESC` set config description (helpful comment)
+- `   --compilerdate=DATE` set compiler date
+- `   --compilerfullversion=VERSION` set full compiler version
+- `   --svncompilerrevision=REV` set revision of used compiler
+- `   --svntestsrevision=REV` set revision of testsuite files
+- `   --svnrtlrevision=REV` set revision of RTL
+- `   --svnpackagesrevision=REV` set revison of packages
+
+The preferred way to specify the options is in a `dbdigest.cfg` file. The
+name of this file is settable using the -f or --config command-line option.
+
+The `dbdigest.cfg` accepts all long versions of the command-line options,
+and you can specify comments using the usual # sign.
+
+## Examples
+Import data from a single testrun, with testrun data in `mytest.cfg`:
+```text
+dbdigest -f mytest.cfg
+```
+The database connection data will be read from the global configuration.
+
+Import data from a list of testruns in `mytests.lst` (4 threads):
+```text
+dbdigest -T mytests.cfg
+```
+Import data from a list of testruns in `mytests.lst` (8 threads):
+```text
+dbdigest -T mytests.cfg -j 8
+```
+
+# DBAdd tool.
+
+To add new CPUs or OSes to the database, use the `dbadd` tool. It will use
+the global `dbdigest.ini` file to connect to the database,  and will add the
+new record in the appropriate table. The tool accepts 3 command-line options:
+- `-t --type=TYPE`  where `TYPE` is one of `os`, `cpu`, `category` or `version`
+- `-v --value=value` the value to add
+- `-d --date=YYYYMMDD` only used when adding a version: the release date of
+    the version (if not specified, today is used).
+
+Test definitions are added automatically during import.
+
+

tests/utils/dbdigest.lpi

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

@@ -23,783 +23,618 @@
 program dbdigest;
 
 uses
-  sysutils,teststr,testu,tresults,dbtests;
+  {$ifdef unix}
+  cthreads,
+  {$endif}
+  types, classes, custapp, sysutils, inifiles, teststr, testu, tresults, dbtests, digestanalyst;
 
+Type
 
-Var
-  StatusCount : Array[TTestStatus] of Integer;
-  UnknownLines : integer;
-
+  { TThreadTask }
 
-Procedure ExtractTestFileName(Var Line : string);
+  TThreadTask = Class(TObject)
+    CfgFileName : string;
+    Config: TDigestConfig;
+    Data: TTestRunData;
+    Constructor Create(const aFileName : String; const aConfig : TDigestConfig; aData : TTestRunData);
+  end;
 
-Var I : integer;
+  { TDBDigestApplication }
+
+  TDBDigestApplication = class(TCustomApplication)
+  Const
+     ShortOpts =
+      'd'+ {  DatabaseName }
+      'h'+ {  Host }
+      'u'+ {  UserName }
+      'p'+ {  Password }
+      'P'+ {  Port }
+      'l'+ {  LogFile }
+      'L'+ {  LongLogFile }
+      'o'+ {  OS }
+      'c'+ {  CPU }
+      'a'+ {  Category }
+      'v'+ {  Version }
+      't'+ {  Date }
+      's'+ {  Submitter }
+      'm'+ {  Machine }
+      'C'+ {  Comment }
+      'S'+ {  TestSrcDir }
+      'r'+ {  RelSrcDir }
+      'T'+ {  ThreadList }
+      'j'+ {  ThreadCount }
+      'V'+ {  Verbose }
+      'Q'  {  SQL }
+     ;
+
+    LongOpts : Array of string = (
+      'databasename',
+      'host',
+      'username',
+      'password',
+      'port',
+      'logfile',
+      'longlogfile',
+      'os',
+      'cpu',
+      'category',
+      'version',
+      'date',
+      'submitter',
+      'machine',
+      'comment',
+      'testsrcdir',
+      'relsrcdir',
+      'threadlist',
+      'threadcount',
+      'verbose',
+      'sql',
+      'compilerdate',
+      'compilerfullversion',
+      'svncompilerrevision',
+      'svntestsrevision',
+      'svnrtlrevision',
+      'svnpackagesrevision'
+    );
+
+  private
+    FTasks : TThreadList;
+    FMaxThreads : Integer;
+    FThreadCount : Integer;
+    // Process the command line. Return true if we can continue
+    function ProcessCommandLine(var aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+    // Check the names of the log files, expanding them if needed.
+    function CheckConfigFiles(lCfg: String; var lData: TTestRunData): Boolean;
+    // Extract a date.
+    class function ExtractDate(aValue: string): TDateTime;
+    // Analyse a log file (i.e. one dbdigest.cfg file)
+    procedure Analyze(const aConfig: TDigestConfig; const aData: TTestRunData);
+    // process a config file (dbdigest.cfg file);
+    procedure ProcessConfigfile(const aFileName: String; var aConfig: TDigestConfig; var aData: TTestRunData);
+    // process a single option. Adapt aConf,aData as needed. Return false if the option was not recognized.
+    function ProcessOption(const aOption: String; aValue: String; var aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+    // Read /etc/dbdigest.ini for database configuration.
+    procedure ReadSystemDBConfig(var aConfig: TDigestConfig);
+    // In thread mode, create a list of tasks.
+    function CreateTaskList(const aBaseConfig: TDigestConfig; const aBaseData: TTestRunData): boolean;
+    // Callback when a task is done. Checks to see if additional threads must be started.
+    procedure TaskDone(Sender: TObject);
+    // Wait for all tasks & threads to terminate.
+    procedure WaitForThreads;
+    // Start as many threads as allowed, up to task count.
+    procedure StartThreads;
+  protected
+    // Run
+    procedure DoRun; override;
+    // Print usage message.
+    procedure Usage(const aMsg: String);
+  Public
+    Constructor Create(aOwner : TComponent); override;
+  end;
 
-begin
-  I:=Pos(' ',Line);
-  If (I<>0) then
-    Line:=Copy(Line,1,I-1);
-end;
+  { TProcessFileThread }
 
-Function Analyse(Var Line : string; Var Status : TTestStatus) : Boolean;
+  TProcessFileThread = class(TThread)
+  Private
+    FTask : TThreadTask;
+    FApp : TDBDigestApplication;
+  Public
+    Constructor Create(aApp : TDBDigestApplication; const aTask : TThreadTask; aOnTerminate : TNotifyEvent);
+    Destructor Destroy; override;
+    Procedure Execute; override;
+  end;
 
-Var
-  TS : TTestStatus;
+{ TThreadTask }
 
+constructor TThreadTask.Create(const aFileName: String; const aConfig: TDigestConfig; aData: TTestRunData);
 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;
+  CfgFileName:=aFileName;
+  Config:=aConfig;
+  Data:=aData;
 end;
 
-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'
- );
+{ TProcessFileThread }
 
+constructor TProcessFileThread.Create(aApp: TDBDigestApplication; const aTask: TThreadTask; aOnTerminate: TNotifyEvent);
+begin
+  FTask:=aTask;
+  FApp:=aApp;
+  Self.OnTerminate:=aOnTerminate;
+  Inherited create(False);
+end;
 
-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);
+destructor TProcessFileThread.Destroy;
+var
+  lPrefix : String;
+  lCfg : String;
 begin
-  Case O of
-    coCompilerDate:
-      TestCompilerDate:=Value;
-    coCompilerFullVersion:
-      TestCompilerFullVersion:=Value;
-    coSvnCompilerRevision:
-      TestSvnCompilerRevision:=Value;
-    coSvnTestsRevision:
-      TestSvnTestsRevision:=Value;
-    coSvnRTLRevision:
-      TestSvnRTLRevision:=Value;
-    coSvnPackagesRevision:
-      TestSvnPackagesRevision:=Value;
+  try
+    lCfg:=FTask.CfgFileName;
+    lPrefix:='['+IntToStr(PtrInt(GetCurrentThreadId))+' - '+lCfg+'] ';
+    FreeAndNil(FTask);
+    Verbose(V_DEBUG,lPrefix+' task destroyed ');
+  except
+    On e : Exception do
+      Verbose(V_WARNING,lPrefix+Format('Error %s during processing of "%s": %s',[E.ClassName,lCfg,E.Message]));
   end;
+  inherited Destroy;
 end;
 
-Procedure SetOpt (O : TConfigOpt; Value : string);
+procedure TProcessFileThread.Execute;
 var
-  year,month,day,min,hour : word;
+  lPrefix:String;
+
 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;
+  try
+    lPrefix:='['+IntToStr(PtrInt(GetCurrentThreadId))+' - '+FTask.CfgFileName+'] ';
+    FApp.Analyze(FTask.Config,FTask.Data);
+    Writeln(IntToStr(PtrInt(GetCurrentThreadId))+'Thread done');
+  except
+    On e : Exception do
+      Verbose(V_WARNING,lPrefix+Format('Error %s during processing of "%s": %s',[E.ClassName,FTask.CfgFileName,E.Message]));
   end;
 end;
 
-Function ProcessOption(S: String) : Boolean;
+class function TDBDigestApplication.ExtractDate(aValue: string): TDateTime;
 
-Var
-  N : String;
-  I : Integer;
-  co : TConfigOpt;
-  coa : TConfigAddOpt;
+var
+  year,month,day,min,hour : word;
 
 begin
-  Verbose(V_DEBUG,'Processing option: '+S);
-  I:=Pos('=',S);
-  Result:=(I<>0);
-  If Result then
+  if (Length(avalue)=12) or (Length(avalue)=8) 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
+      year:=StrToInt(Copy(avalue,1,4));
+      month:=StrToInt(Copy(avalue,5,2));
+      day:=StrToInt(Copy(aValue,7,2));
+      if Length(avalue)=12 then
         begin
-          SetOpt(co,S);
-          Exit;
+        hour:=StrToInt(Copy(aValue,9,2));
+        min:=StrToInt(Copy(aValue,11,2));
         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:=EncodeDate(year,month,day)+EncodeTime(hour,min,0,0);
+    end
+  else
+    Verbose(V_Error,'Error in date format, use YYYYMMDDhhmm');
 end;
 
-Procedure ProcessConfigfile(FN : String);
-
-Var
-  F : Text;
-  S : String;
-  I : Integer;
+function TDBDigestApplication.ProcessOption(const aOption: String; aValue: String; var aConfig: TDigestConfig;
+  var aData: TTestRunData): Boolean;
 
 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
-    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);
+  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;
+    'sql': dosql:=true;
+    'T','threadlist' : ; // treated elsewhere
+    'j','threadcount' : ; // treated elsewhere
+    '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 ProcessCommandLine;
+procedure TDBDigestApplication.ProcessConfigfile(const aFileName: String; var aConfig: TDigestConfig; var aData: TTestRunData);
 
 Var
+  Cfg : TStrings;
+  aLine,S,N,V : String;
   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
+  // Set the default value for old digests without RelSrcDir to the rtl/compiler
+  // testsuite
+  If Not FileExists(aFileName) Then
+    Exit;
+  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 }
+
+procedure TDBDigestApplication.Usage(const aMsg: String);
 
-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;
+  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('-T --threadlist=FILE              file with configuration file names to imports.');
+  Writeln('-j --threadcount=N                Number of threads to use');
+  Writeln('-V --verbose                      be more verbose');
+  Writeln('Test run data:');
+  Writeln('-l --logfile=FILE                 set log file to analyse');
+  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('If -T is specified, no test run options may be specified');
+  Writeln('');
+  Writeln('The config file can contain the same options as the command-line in the form.');
+  Writeln('option=value');
+  Writeln('where option is the long or short version of the option');
+  Writeln('comments may be included using the # character.');
+  ExitCode:=Ord(aMsg<>'');
 end;
 
-Function GetLog(Line, FN : String) : String;
-
+constructor TDBDigestApplication.Create(aOwner: TComponent);
 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;
+  inherited Create(aOwner);
+  FTasks:=TThreadList.Create;
 end;
 
-Function GetExecuteLog(Line, FN : String) : String;
+function TDBDigestApplication.ProcessCommandLine(var aConfig: TDigestConfig; var aData : TTestRunData): Boolean;
+
+  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;
+
+  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
+      begin
+      Result[1+I]:=S[I];
+      if (S[I]<>'verbose') and (S[I]<>'sql') then
+        Result[1+I]:=Result[1+I]+':';
+      end;  
+  end;
+
+var
+  Long,ErrMsg,lValue : String;
+  Short : Char;
+  I : integer;
+  lHas : boolean;
 
 begin
-  if UseLongLog then
+  ErrMsg:=CheckOptions(MakeOpts(ShortOpts)+'H',MakeLongOpts(LongOpts));
+  Result:=(ErrMsg='');
+  if (not Result) or HasOption('H','help') then
     begin
-      Result:=GetContentsFromLongLog(Line);
-      exit;
+    Usage(ErrMsg);
+    Exit(false);
     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
+  I:=0;
+  For Long in LongOpts do
     begin
-      Verbose(V_Warning,'File "'+FN+'" not found');
-      Result:='';
+    Inc(I);
+    if I<=Length(ShortOpts) then
+      begin
+      Short:=ShortOpts[I];
+      if Short='r' then
+        Writeln('ag');
+      lHas:=HasOption(Short,Long);
+      lValue:=GetOptionValue(Short,Long);
+      end
+    else
+      begin
+      Short:=#0;
+      lHas:=HasOption(Long);
+      lValue:=GetOptionValue(Long);
+      end;
+    if lHas then
+      ProcessOption(long,lValue,aConfig,aData);
     end;
+  Result:=True;
 end;
 
-Procedure Processfile (FN: String);
+procedure TDBDigestApplication.Analyze(const aConfig : TDigestConfig; const aData : TTestRunData);
 
 var
-  logfile : text;
-  fullline,line,prevLine : string;
-  TS,PrevTS : TTestStatus;
-  ID,PrevID : integer;
-  Testlog : string;
-  count_test : boolean;
+  lSQL : TTestSQL;
+  lDigest : TDBDigestAnalyzer;
+  lPrefix : string;
+
 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
-    begin
-    readln(logfile,line);
-    fullline:=line;
-    ts:=stFailedToCompile;
-    If analyse(line,TS) 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;
+  lDigest:=Nil;
+  With aConfig do
+    lSQL:=TTestSQL.create(databasename,host,username,password,port);
+  try
+    lSQL.ConnectToDatabase;
+    if GetCurrentThreadId<>MainThreadID then
+      lPrefix:='['+IntToStr(PtrInt(GetCurrentThreadId))+' - '+aData.logfile+']: '
+    else
+      lPrefix:='';
+    lSQL.LogPrefix:=lPrefix;
+    lDigest:=TDBDigestAnalyzer.Create(lSQL,lPrefix);
+    lDigest.Analyse(aConfig,aData);
+  finally
+    lDigest.Free;
+    lSQL.Free;
+  end;
+end;
 
-          end;
-        end
-      else
-        begin
-          Inc(StatusCount[TS]);
-          PrevTS:=TS;
-          PrevID:=RequireTestID(line);
-          PrevLine:=line;
-        end;
+procedure TDBDigestApplication.ReadSystemDBConfig(var aConfig : TDigestConfig);
 
-      end
-    else
-      begin
-        Inc(UnknownLines);
-        Verbose(V_Warning,'Unknown line: "'+line+'"');
-      end;
+// Keep filename in sync with algorithm in dbadd
+
+var
+  lFileName : String;
+  Ini : TCustomIniFile;
+
+begin
+  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;
-  close(logfile);
 end;
 
-procedure UpdateTestRun;
+function TDBDigestApplication.CheckConfigFiles(lCfg : String; var lData : TTestRunData) : Boolean;
+
+  function CheckFile(const aDir : String; var aFile : String) : boolean;
 
   var
-     i : TTestStatus;
-     qry : string;
+    lExpanded : 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);
+    if (aFile<>'') and (aFile[1]<>'/') then
+      begin
+      lExpanded:=aDir+aFile;
+      Verbose(V_Debug,Format('Expanding file from %s to %s',[aFile,lExpanded]));
+      aFile:=lExpanded;
+      end;
+    Result:=FileExists(aFile);
+    if not Result then
+       Verbose(V_Warning,Format('file does not exist: %s',[lExpanded]));
   end;
 
-function GetTestConfigId : Integer;
 var
-  qry : string;
+  lDir : String;
+
 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;
+  lDir:=ExtractFilePath(ExpandFileName(lCfg));
+  Result:=CheckFile(lDir,lData.logfile);
+  if Result then
+    Result:=CheckFile(lDir,lData.longlogfile);
 end;
 
-function UpdateTestConfigID : boolean;
+
+function TDBDigestApplication.CreateTaskList(const aBaseConfig: TDigestConfig; const aBaseData: TTestRunData) : boolean;
+
 var
-  qry : string;
-  firstRunID, lastRunID,PrevRunID : Integer;
-  RunCount : Integer;
-  AddCount : boolean;
+  lCfg,lFileName : String;
+  L : TStrings;
+  lConfig : TDigestConfig;
+  lData : TTestRunData;
+  lList : TList;
+
 
 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');
-    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
+  Result:=False;
+  lFileName:=GetOptionValue('T','threadlist');
+  if not FileExists(lFileName) 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');
+    Verbose(V_Normal,'No such file :'+lFileName);
+    Exit;
     end;
-  UpdateTestConfigID:=true;
+  L:=TStringList.Create;
+  try
+    l.LoadFromFile(lFileName);
+    Result:=True;
+    For lcfg in L do
+      begin
+      if not FileExists(lCfg) then
+        begin
+        Verbose(V_Warning,'No such file: '+lcfg);
+        Result:=False;
+        end
+      else
+        begin
+        lConfig:=aBaseConfig;
+        lData:=aBaseData;
+        lList:=FTasks.LockList;
+        ProcessConfigfile(lCfg,lConfig,lData);
+        if CheckConfigFiles(lCfg,lData) then
+          lList.Add(TThreadTask.Create(lCfg,lConfig,lData))
+        else
+          Result:=False;
+        end;
+      end;
+  finally
+    l.Free;
+  end;
 end;
 
-function InsertNewTestConfigId : longint;
-var
-  qry : string;
+procedure TDBDigestApplication.TaskDone(Sender: TObject);
 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);
+  InterlockedDecrement(FThreadCount);
+  StartThreads;
 end;
 
-procedure UpdateTestConfig;
+Procedure TDBDigestApplication.StartThreads;
 
-  begin
-    if GetTestPreviousRunHistoryID(TestRunID) <> -1 then
-      begin
-      Verbose(V_DEBUG,format('TestRun %d already in TestHistory table',[TestRunID]));
-      exit;
-      end;
+var
+  L : TList;
+  lTask : TThreadTask;
 
-    if GetTestConfigID >= 0 then
-      begin
-        if not UpdateTestConfigID then
-          Verbose(V_Warning, ' Update of TESTCONFIG table failed');
-      end
-    else
+begin
+  L:=FTasks.LockList;
+  try
+    Verbose(V_DEBUG,Format('Starting tasks. Current thread count: %d remaining tasks: %d.',[FThreadCount,l.Count]));
+    While (L.Count>0) and (FThreadCount<FMaxThreads) do
       begin
-        if InsertNewTestConfigID = -1 then
-          Verbose(V_Warning, ' Insert of new entry into TESTCONFIG table failed');
+      lTask:=TThreadTask(L[0]);
+      L.Delete(0);
+      Verbose(V_DEBUG,'Starting task for '+lTask.CfgFileName);
+      TProcessFileThread.Create(Self,lTask,@TaskDone);
+      InterlockedIncrement(FThreadCount);
       end;
+  finally
+    FTasks.UnlockList;
   end;
+end;
 
+procedure TDBDigestApplication.WaitForThreads;
+
+var
+  lDone : Boolean;
+  lList : TList;
 
 begin
-  ProcessConfigFile('dbdigest.cfg');
-  ProcessCommandLine;
-  If LogFileName<>'' then
+  Repeat
+    CheckSynchronize;
+    Sleep(100);
+    lList:=FTasks.LockList;
+    try
+      Verbose(V_DEBUG,Format('Waiting...(Todo: %d threads: %d)',[lList.Count,FThreadCount]));
+      lDone:=(lList.Count=0) and (FThreadCount=0);
+    finally
+      FTasks.UnlockList;
+    end
+  until ldone;
+end;
+
+procedure TDBDigestApplication.DoRun;
+
+var
+  lConfigFile : String;
+  lConfig : TDigestConfig;
+  lData : TTestRunData;
+begin
+  Terminate;
+  lConfigFile:=GetOptionValue('f','config');
+  if lConfigFile='' then
+    lConfigFile:='dbdigest.cfg';
+  lConfig:=Default(TDigestConfig);
+  lConfig.RelSrcDir:='tests/';
+  ReadSystemDBConfig(lConfig);
+  if not HasOption('T','threadlist') 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
+    lData:=Default(TTestRunData);
+    ProcessConfigFile(lConfigFile,lConfig,lData);
+    if ProcessCommandLine(lConfig,lData) then
+      Analyze(lConfig,lData);
     end
   else
-    Verbose(V_ERROR,'Missing log file name');
+    begin
+    FMaxThreads:=StrToIntDef(GetOptionValue('j','threadcount'),4);
+    if ProcessCommandLine(lConfig,lData) then
+      if CreateTaskList(lConfig,lData) then
+        begin
+        StartThreads;
+        WaitForThreads;
+        end;
+    end;
+end;
+
+var
+  Application : TDBDigestApplication;
+
+begin
+  Application:=TDBDigestApplication.Create(Nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
 end.

tests/utils/dbtests.pp

@@ -6,105 +6,216 @@ unit dbtests;
 Interface
 
 Uses
-  sqldb, testu;
-
-{ ---------------------------------------------------------------------
-  High-level access
-  ---------------------------------------------------------------------}
-
-Function GetTestID(Name : string) : Integer;
-Function GetOSID(Name : String) : Integer;
-Function GetCPUID(Name : String) : Integer;
-Function GetCategoryID(Name : String) : Integer;
-Function GetVersionID(Name : String) : Integer;
-Function GetRunID(OSID, CPUID, VERSIONID : Integer; Date : TDateTime) : Integer;
-Function AddRun(OSID, CPUID, VERSIONID, CATEGORYID : Integer; Date : TDateTime) : Integer;
-Function AddTest(Name : String; AddSource : Boolean) : Integer;
-Function UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
-Function AddTestResult(TestID,RunID,TestRes : Integer;
-                       OK, Skipped : Boolean;
-                       Log : String;var count_it : boolean) : Integer;
-Function RequireTestID(Name : String): Integer;
-Function CleanTestRun(ID : Integer) : Boolean;
-function GetTestPreviousRunHistoryID(TestRunID : Integer) : Integer;
-function GetTestNextRunHistoryID(TestRunID : Integer) : Integer;
-function AddTestHistoryEntry(TestRunID,TestPreviousID : Integer) : boolean;
-
-{ ---------------------------------------------------------------------
-    Low-level DB access.
-  ---------------------------------------------------------------------}
-
-Function  ConnectToDatabase(DatabaseName,Host,User,Password,Port : String) : Boolean;
-Procedure DisconnectDatabase;
-Function  InsertQuery(const Query : string) : Integer;
-Function  ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
-Function  OpenQuery (Qry : String; Out Res : TSQLQuery; Silent : Boolean) : Boolean ;
-Procedure FreeQueryResult (Var Res : TSQLQuery);
-Function  GetResultField (Res : TSQLQuery; Id : Integer) : String;
-Function  IDQuery(Qry : String) : Integer;
-Function  StringQuery(Qry : String) : String;
-Function  EscapeSQL( S : String) : String;
-Function  SQLDate(D : TDateTime) : String;
-
+  sqldb, 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;
+    FConnection : TPQConnection;
+    FDatabaseName : String;
+    FHost : String;
+    FUser : String;
+    FPassword : String;
+    FPort : Word;
+    Flogprefix : String;
+    Class Procedure FreeQueryResult (Var Res : TSQLQuery);
+    Class Function  GetIntResultField (Res : TSQLQuery; Id : Integer) : Integer;
+    Class Function  GetInt64ResultField (Res : TSQLQuery; Id : Integer) : Int64;
+    Class Function  GetStrResultField (Res : TSQLQuery; Id : Integer) : String;
+    // Overload adds prefix
+    procedure Verbose(aLevel : TVerboseLevel; const aMsg : string);
+    { ---------------------------------------------------------------------
+        Low-level DB access.
+      ---------------------------------------------------------------------}
+
+    // Create query object.
+    function CreateQuery(const ASQL: String): TSQLQuery;
+    // create and open a query, return in Res.
+    Function  OpenQuery (Qry : String; Out Res : TSQLQuery; Silent : Boolean) : Boolean ;
+    // Run query, return first field as integer. -1 on error or no data.
+    Function  IDQuery(Qry : String) : Integer;
+    // Run query, return first field as int64. -1 on error or no data.
+    Function  ID64Query(Qry : String) : Int64;
+    // Run query, return first field as string. Empty string on error or no data.
+    Function  StringQuery(Qry : String) : String;
+  Public
+    { ---------------------------------------------------------------------
+      High-level access
+      ---------------------------------------------------------------------}
+    // Constructor.
+    Constructor create(aDatabaseName,aHost,aUser,aPassword : String; aPort : Word);
+    // Destructor
+    Destructor destroy; override;
+    // Try to connect to database with params given in constructor.
+    Function ConnectToDatabase : Boolean;
+    // Disconnect from database
+    Procedure DisconnectDatabase;
+    // Execute a query, return true if it executed without error.
+    Function  ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
+    // Adding things
+    // Add a category.
+    Function AddCategory(const aName : String) : Integer;
+    // Add a CPU.
+    Function AddCPU(const aName : String) : Integer;
+    // Add an OS.
+    Function AddOS(const aName : String) : Integer;
+    // Add a compiler version.
+    function AddVersion(const aName: String; aReleaseDate: TDateTime): Integer;
+    // Add a platform.
+    Function AddPlatform(const aData : TTestRunData) : Integer;
+    // Add a test and return the ID. If the test already exists, return it's ID
+    Function AddTest(Name : String; AddSource : Boolean) : Integer;
+    // Add a test run. Return the test run ID.
+    function AddRun(const aData: TTestRunData): Int64;
+    // Ad test result and return ID. If a result exists already for the given run/test, update and return ID.
+    Function AddTestResult(aData : TTestResultData) : Int64;
+    // Add LastTestResult. If it exists already with given platform/test, update result ID.
+    function AddLastResult(TestID, PlatformID: Integer; ResultID: Int64): Boolean;
+    // Add previousTestResult. If it exists already with given platform/test, update result ID.
+    function AddPreviousResult(TestID, PlatformID: Integer; ResultID: Int64): Boolean;
+    //
+    // Get ID based on key. All keys are case sensitive. If a key does not exist, -1 is returned.
+    //
+    // Get test ID based on test name.
+    Function GetTestID(Name : string) : Integer;
+    // Get OS ID based on OS name.
+    Function GetOSID(Name : String) : Integer;
+    // Get CPU ID based on CPU name.
+    Function GetCPUID(Name : String) : Integer;
+    // Get category ID based on Category name.
+    Function GetCategoryID(Name : String) : Integer;
+    // Get version ID based on version name.
+    Function GetVersionID(Name : String) : Integer;
+    // Get platform ID based on OS, cpu, category, config.
+    function GetPlatformID(aData: TTestRunData; aAllowCreate: Boolean): Integer;
+    // Get run ID based on platform/date.
+    Function GetRunID(aData : TTestRunData) : Int64;
+    // Get last test result ID based on platform/test.
+    function GetLastTestResult(aTestID, aPlatFormID: Integer): TTestResultData;
+    // Update tests
+    Function UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
+    function UpdateTestResult(aData: TTestResultData): Int64;
+    function UpdateTestRun(aData : TTestRunData): Boolean;
+    // Create test if it does not exist yet.
+    Function RequireTestID(Name : String): Integer;
+    // Delete all results from a test run.
+    Function CleanTestRun(ID : Integer) : Boolean;
+    // Escape SQL (quotes etc.
+    Class Function  EscapeSQL(S : String) : String;
+    // return SQL date
+    Class Function  SQLDate(D : TDateTime) : String;
+    // Rel src dir
+    Property RelSrcDir : String Read FRelSrcDir Write FRelSrcDir;
+    // test src dir.
+    Property TestSrcDir : string read FTestSrcDir Write FTestSrcDir;
+    // Prefix to use when logging (in case of multi-thread)
+    Property LogPrefix : String Read FLogPrefix Write FLogPrefix;
+  end;
 
-var
-  RelSrcDir,
-  TestSrcDir : string;
 
 Implementation
 
 Uses
-  SysUtils, pqconnection;
-
-Var
-  Connection : TPQConnection;
+  SysUtils;
 
 { ---------------------------------------------------------------------
     Low-level DB access.
   ---------------------------------------------------------------------}
 
-Function ConnectToDatabase(DatabaseName,Host,User,Password,Port : String) : Boolean;
+function TTestSQL.ConnectToDatabase: Boolean;
 
 begin
   Result:=False;
-  Verbose(V_SQL,'Connection params : '+DatabaseName+' '+Host+' '+User+' '+Port);
-  Connection:=TPQConnection.Create(Nil);
+  Verbose(V_SQL,'Connection params : '+FDatabaseName+' '+FHost+' '+FUser+' '+IntToStr(FPort));
+  FConnection:=TPQConnection.Create(Nil);
   try
-    Connection.Hostname:=Host;
-    Connection.DatabaseName:=DatabaseName;
-    Connection.Username:=User;
-    Connection.Password:=Password;
-    Connection.Connected:=true;
-    Connection.Transaction:=TSQLTransaction.Create(Connection);
-    if (Port<>'') then
-      Connection.Params.Values['Port']:=Port;
+    FConnection.Hostname:=FHost;
+    FConnection.DatabaseName:=FDatabaseName;
+    FConnection.Username:=FUser;
+    FConnection.Password:=FPassword;
+    FConnection.Connected:=true;
+    FConnection.Transaction:=TSQLTransaction.Create(FConnection);
+    if (FPort<>0) then
+      FConnection.Params.Values['Port']:=IntToStr(FPort);
+    FConnection.Connected:=True;
+    Result:=True
   except
     On E : Exception do
       begin
       Verbose(V_ERROR,'Failed to connect to database : '+E.Message);
-      FreeAndNil(Connection);
+      FreeAndNil(FConnection);
       end;
   end;
 end;
 
-Procedure DisconnectDatabase;
+procedure TTestSQL.DisconnectDatabase;
 
 begin
-  FreeAndNil(Connection);
+  FreeAndNil(FConnection);
 end;
 
-Function CreateQuery(Const ASQL : String) : TSQLQuery;
+function TTestSQL.AddCategory(const aName: String): Integer;
+
+Const
+  SQLInsert = 'INSERT INTO TESTCATEGORY (TA_NAME) VALUES (''%s'') RETURNING TA_ID';
 
 begin
-  Result:=TSQLQuery.Create(Connection);
-  Result.Database:=Connection;
-  Result.Transaction:=Connection.Transaction;
-  Result.SQL.Text:=ASQL;
+  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
+  Result:=TSQLQuery.Create(FConnection);
+  Result.Database:=FConnection;
+  Result.Transaction:=FConnection.Transaction;
+  Result.SQL.Text:=ASQL;
+end;
 
 
-Function ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
+function TTestSQL.ExecuteQuery(Qry: String; Silent: Boolean): Boolean;
 
 begin
   Verbose(V_SQL,'Executing query:'+Qry);
@@ -121,14 +232,14 @@ begin
   except
     On E : exception do
       begin
-      Connection.Transaction.RollBack;
+      FConnection.Transaction.RollBack;
       if not Silent then
         Verbose(V_WARNING,'Query : '+Qry+'Failed : '+E.Message);
       end;
   end;
 end;
 
-Function OpenQuery (Qry : String; Out res : TSQLQuery; Silent : Boolean) : Boolean ;
+function TTestSQL.OpenQuery(Qry: String; out Res: TSQLQuery; Silent: Boolean): Boolean;
 
 begin
   Result:=False;
@@ -142,7 +253,7 @@ begin
       begin
       FreeAndNil(Res);
       Try
-        Connection.Transaction.RollBack;
+        FConnection.Transaction.RollBack;
       except
       end;
       if not Silent then
@@ -151,18 +262,53 @@ begin
   end;
 end;
 
-Function GetResultField (Res : TSQLQuery; Id : Integer) : String;
+class function TTestSQL.GetIntResultField(Res: TSQLQuery; Id: Integer): Integer;
 
 
 begin
-  If (Res=Nil) or (ID>=Res.Fields.Count) then
+  If (Res=Nil) or (res.IsEmpty) or (ID>=Res.Fields.Count) then
+    Result:=-1
+  else
+    Result:=Res.Fields[ID].AsInteger;
+  testu.Verbose(V_SQL,'Field value '+IntToStr(Result));
+end;
+
+class function TTestSQL.GetInt64ResultField(Res: TSQLQuery; Id: Integer): Int64;
+begin
+  If (Res=Nil) or (res.IsEmpty) or (ID>=Res.Fields.Count) then
+    Result:=-1
+  else
+    Result:=Res.Fields[ID].AsLargeInt;
+  testu.Verbose(V_SQL,'Field value '+IntToStr(Result));
+end;
+
+class function TTestSQL.GetStrResultField(Res: TSQLQuery; Id: Integer): String;
+begin
+  If (Res=Nil) or (res.IsEmpty) or (ID>=Res.Fields.Count) then
     Result:=''
   else
     Result:=Res.Fields[ID].AsString;
-  Verbose(V_SQL,'Field value '+Result);
+  testu.Verbose(V_SQL,'Field value '+Result);
+end;
+
+procedure TTestSQL.Verbose(aLevel: TVerboseLevel; const aMsg: string);
+begin
+  testu.Verbose(aLevel,logPrefix+aMsg);
+end;
+
+function TTestSQL.AddPlatform(const aData : TTestRunData) : Integer;
+
+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;
 
-Procedure FreeQueryResult(var Res : TSQLQuery);
+class procedure TTestSQL.FreeQueryResult(var Res: TSQLQuery);
 
 begin
   if Assigned(Res) and Assigned(Res.Transaction) then
@@ -170,7 +316,7 @@ begin
   FreeAndNil(Res);
 end;
 
-Function IDQuery(Qry : String) : Integer;
+function TTestSQL.IDQuery(Qry: String): Integer;
 
 Var
   Res : TSQLQuery;
@@ -179,13 +325,27 @@ begin
   Result:=-1;
   If OpenQuery(Qry,Res,False) then
     try
-      Result:=StrToIntDef(GetResultField(Res,0),-1);
+      Result:=GetIntResultField(Res,0);
     finally
       FreeQueryResult(Res);
     end;
 end;
 
-Function StringQuery(Qry : String) : String;
+function TTestSQL.ID64Query(Qry: String): Int64;
+Var
+  Res : TSQLQuery;
+
+begin
+  Result:=-1;
+  If OpenQuery(Qry,Res,False) then
+    try
+      Result:=GetInt64ResultField(Res,0);
+    finally
+      FreeQueryResult(Res);
+    end;
+end;
+
+function TTestSQL.StringQuery(Qry: String): String;
 
 Var
   Res : TSQLQuery;
@@ -194,22 +354,37 @@ begin
   Result:='';
   If OpenQuery(Qry,Res,False) then
     try
-      Result:=GetResultField(Res,0);
+      Result:=GetStrResultField(Res,0);
     finally
       FreeQueryResult(Res);
     end;
 end;
 
-Function EscapeSQL( S : String) : 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;
+
+class function TTestSQL.EscapeSQL(S: String): String;
 
 begin
 //  Result:=StringReplace(S,'\','\\',[rfReplaceAll]);
   Result:=StringReplace(S,'''','''''',[rfReplaceAll]);
-  Verbose(V_SQL,'EscapeSQL : "'+S+'" -> "'+Result+'"');
+  testu.Verbose(V_SQL,'EscapeSQL : "'+S+'" -> "'+Result+'"');
 end;
 
 
-Function SQLDate(D : TDateTime) : String;
+class function TTestSQL.SQLDate(D: TDateTime): String;
 
 begin
   Result:=FormatDateTime('YYYY/MM/DD hh:nn:ss',D);
@@ -220,7 +395,7 @@ end;
   ---------------------------------------------------------------------}
 
 
-Function GetTestID(Name : string) : Integer;
+function TTestSQL.GetTestID(Name: string): Integer;
 
 Const
   SFromName = 'SELECT T_ID FROM TESTS WHERE (T_NAME=''%s'')';
@@ -229,7 +404,7 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-Function GetOSID(Name : String) : Integer;
+function TTestSQL.GetOSID(Name: String): Integer;
 
 Const
   SFromName = 'SELECT TO_ID FROM TESTOS WHERE (TO_NAME=''%s'')';
@@ -238,7 +413,7 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-Function GetVersionID(Name : String) : Integer;
+function TTestSQL.GetVersionID(Name: String): Integer;
 
 Const
   SFromName = 'SELECT TV_ID FROM TESTVERSION WHERE (TV_VERSION=''%s'')';
@@ -247,7 +422,25 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-Function GetCPUID(Name : String) : Integer;
+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
   SFromName = 'SELECT TC_ID FROM TESTCPU WHERE (TC_NAME=''%s'')';
@@ -256,164 +449,96 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-Function GetCategoryID(Name : String) : Integer;
+function TTestSQL.GetCategoryID(Name: String): Integer;
 
 Const
-  SFromName = 'SELECT TCAT_ID FROM TESTCATEGORY WHERE (TCAT_NAME=''%s'')';
+  SFromName = 'SELECT TA_ID FROM TESTCATEGORY WHERE (TA_NAME=''%s'')';
 
 begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-Function 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 InsertQuery(const Query : string) : Integer;
-
-begin
-  Result:=IDQuery(Query);
+  With aData do
+    Result:=ID64Query(Format(SFromIDS,[PlatFormID,SQLDate(Date)]));
 end;
 
-Function 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 GetUnitTestConfig(const fn : string; var r : TConfig) : Boolean;
-var
-  Path       : string;
-  ClassName  : string;
-  MethodName : 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;
-  MethodName := copy(fn,slashpos+1,length(fn));
-  Path := copy(fn,1,slashpos-1);
-  slashpos := posr('/',Path);
-  if slashpos > 0 then
-    begin
-    ClassName := copy(Path,slashpos+1,length(Path));
-    Path := copy(Path,1,slashpos-1);
-    end
-  else
-    begin
-    ClassName := Path;
-    path := '.';
-    end;
-  if upper(ClassName[1])<>'T' then exit;
-  FileName := TestSrcDir+RelSrcDir+Path+DirectorySeparator+copy(lowercase(ClassName),2,length(classname));
-  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,ClassName+'.'+MethodName) then
-               begin
-                 Result := True;
-                 r.Note:= 'unittest';
-               end;
-            end;
-         end;
-      end;
-   end;
-  close(t);
-end;
 
-Function AddTest(Name : String; AddSource : Boolean) : Integer;
+function TTestSQL.AddTest(Name: String; AddSource: Boolean): Integer;
 
 Const
   SInsertTest = 'INSERT INTO TESTS (T_NAME,T_ADDDATE)'+
-                ' VALUES (''%s'',NOW())';
+                ' VALUES (''%s'',NOW()) ON CONFLICT (T_NAME) DO UPDATE SET T_ADDDATE=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_Debug,'Checking test filename: '+lFileName);
+  Result:=IDQuery(Format(SInsertTest,[Name]));
+  If Result=-1 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
+    Verbose(V_WARNING,'Could not add test!');
+    exit;
+    end;
+  If (FileExists(lFileName) and GetConfig(logprefix,lFileName,Info))
+     or GetUnitTestConfig(logprefix,Name,lSrcDir,Info) then
+    begin
+    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 UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
+function TTestSQL.UpdateTest(ID: Integer; Info: TConfig; Source: String): Boolean;
 
 Const
   SUpdateTest = 'Update TESTS SET '+
@@ -438,103 +563,177 @@ 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 AddTestResult(TestID,RunID,TestRes : Integer;
-                       OK, Skipped : Boolean;
-                       Log : String;var count_it : boolean) : Integer;
+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);
 end;
 
-Function RequireTestID(Name : String): Integer;
+function TTestSQL.GetLastTestResult(aTestID, aPlatFormID: Integer): TTestResultData;
+
+Const
+  SQLSelect = 'SELECT TESTRESULTS.*, TU_DATE FROM '+
+              ' TESTLASTRESULTS '+
+              ' INNER JOIN TESTRESULTS ON (TL_TESTRESULTS_FK=TR_ID) '+
+              ' INNER JOIN TESTRUN ON (TR_TESTRUN_FK=TU_ID) '+
+              'WHERE '+
+              ' (TL_TEST_FK=%d) '+
+              ' AND (TL_PLATFORM_FK=%d)';
+
+var
+  Qry : TSQLQuery;
 
 begin
-  Result:=GetTestID(Name);
-  If Result=-1 then
-    Result:=AddTest(Name,FileExists(Name));
-  If Result=-1 then
-    Verbose(V_WARNING,'Could not find or create entry for test '+Name);
+  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;
+      Result.Date:=Qry.FieldByName('TU_DATE').AsDateTime;
+      end
+    else
+      Result.ID:=-1;
+  finally
+    if Qry.SQLTransaction.Active then
+      Qry.SQLTransaction.Commit;
+    Qry.Free;
+  end;
+
 end;
 
-Function CleanTestRun(ID : Integer) : Boolean;
+function TTestSQL.AddLastResult(TestID, PlatformID: Integer; ResultID: Int64) : Boolean;
 
-Const
-  SDeleteRun = 'DELETE FROM TESTRESULTS WHERE TR_TESTRUN_FK=%d';
+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(SDeleteRun,[ID]),False);
+  Result:=ExecuteQuery(Format(SQLInsert,[TestId,PlatFormID,ResultID]),False);
 end;
 
-function GetTestPreviousRunHistoryID(TestRunID : Integer) : Integer;
+function TTestSQL.AddPreviousResult(TestID, PlatformID: Integer; ResultID: Int64): Boolean;
+const
+  SQLInsert = 'Insert into TESTPREVIOUSRESULTS '+
+             '  (TPR_TEST_FK,TPR_PLATFORM_FK,TPR_TESTRESULTS_FK) '+
+             'VALUES '+
+             '  (%d,%d,%d) '+
+             'ON CONFLICT (TPR_TEST_FK,TPR_PLATFORM_FK) '+
+             'DO UPDATE SET TPR_TESTRESULTS_FK = EXCLUDED.TPR_TESTRESULTS_FK ';
+
 begin
-  GetTestPreviousRunHistoryID:=IDQuery(
-    format('SELECT TH_PREVIOUS_FK FROM TESTRUNHISTORY WHERE TH_ID_FK=%d',[TestRunID]));
+  Result:=ExecuteQuery(Format(SQLInsert,[TestId,PlatFormID,ResultID]),False);
 end;
 
-function GetTestNextRunHistoryID(TestRunID : Integer) : Integer;
+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
-  GetTestNextRunHistoryID:=IDQuery(
-    format('SELECT TH_ID_FK FROM TESTRUNHISTORY WHERE TH_PREVIOUS_FK=%d',[TestRunID]));
+  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 AddTestHistoryEntry(TestRunID,TestPreviousID : Integer) : boolean;
+function TTestSQL.RequireTestID(Name: String): Integer;
 
-var
-  qry : string;
+begin
+  Result:=GetTestID(Name);
+  If Result=-1 then
+    Result:=AddTest(Name,True);
+  If Result=-1 then
+    Verbose(V_WARNING,'Could not find or create entry for test '+Name);
+end;
+
+function TTestSQL.CleanTestRun(ID: Integer): Boolean;
+
+Const
+  SDeleteRun = 'DELETE FROM TESTRESULTS WHERE TR_TESTRUN_FK=%d';
 
 begin
-  Qry:=format('INSERT INTO TESTRUNHISTORY (TH_ID_FK,TH_PREVIOUS_FK) '+
-              ' VALUES (%d,%d)',[TestRunID,TestPreviousID]);
-  Result:=ExecuteQuery(Qry,False);
+  Result:=ExecuteQuery(Format(SDeleteRun,[ID]),False);
 end;
 
+
 end.

tests/utils/digestanalyst.pas

@@ -0,0 +1,420 @@
+unit digestanalyst;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, teststr, testu, tresults, dbtests;
+
+Type
+  // Program configuration
+  TDigestConfig = record
+    databasename: string;
+    host: string;
+    username: string;
+    password: string;
+    port: integer;
+    testsrcdir: string;
+    relsrcdir: string;
+    verbose: string;
+    sql: string;
+  end;
+
+
+  { TDBDigestAnalyzer }
+
+  TDBDigestAnalyzer = Class(TObject)
+  private
+    FDB : TTestSQL;
+    LongLogFile : TStrings;
+    UnknownLines : integer;
+    UseLongLog : Boolean;
+    FCurLongLogLine : Integer;
+    FPrefix : String;
+    // Call global verbose with prefix to message.
+    procedure Verbose(aLevel : TVerboseLevel; const aMsg : string);
+    // Get the execute log for a given test
+    function GetExecuteLog(Line, FN: String): String;
+    // Get the IDs from all config parameters: OS, Log,
+    function GetIDs(const aConfig: TDigestConfig; var aData: TTestRunData): Boolean;
+    // Check that all IDS needed for a test run are <>-1
+    function CheckIDs(var aData: TTestRunData): Boolean;
+    // process a log file.
+    procedure Processfile(const aFileName: String; var aData: TTestRunData);
+    // Update the test run statistics.
+    procedure UpdateTestRun(const aData: TTestRunData);
+    // Get contents from longlog
+    function GetContentsFromLongLog(Line: String): String;
+    // Get Log from file line
+    function GetLog(Line, FN: String): String;
+  public
+    constructor Create(aDB : TTestSQL; const aPrefix : String);
+    // Extract the status from a log line. Will change the log line.
+    class function AnalyseLine(var Line: string; var Status: TTestStatus): Boolean;
+    // Extract test filename from a log line
+    class procedure ExtractTestFileName(var Line: string);
+    // Analyse the file.
+    procedure Analyse(aConfig : TDigestConfig; aData : TTestRunData);
+    // Save test result. Return true if a NEW test result record was created (and the result must be counted)
+    function SaveTestResult(var aResult: TTestResultData): Boolean;
+    // DB connection to use
+    property DB : TTestSQL read FDB;
+  end;
+
+
+implementation
+
+constructor TDBDigestAnalyzer.Create(aDB: TTestSQL; const aPrefix: String);
+begin
+  FDB:=aDB;
+  FPrefix:=aPrefix;
+end;
+
+procedure TDBDigestAnalyzer.Verbose(aLevel: TVerboseLevel; const aMsg: string);
+begin
+  testu.Verbose(aLevel,FPrefix+aMsg);
+end;
+
+function TDBDigestAnalyzer.CheckIDs(var aData : TTestRunData): Boolean;
+
+begin
+  If aData.CategoryID=-1 then
+    aData.CategoryID:=1;
+  Result:=(aData.CPUID<>-1) and (aData.OSID<>-1) and (aData.VersionID<>-1);
+  if Result then
+    exit;
+  If aData.CPUID=-1 then
+    Verbose(V_WARNING,'NO ID for CPU "'+aData.CPU+'" found.');
+  If aData.OSID=-1 then
+    Verbose(V_WARNING,'NO ID for OS "'+aData.OS+'" found.');
+  If aData.VersionID=-1 then
+    Verbose(V_WARNING,'NO ID for version "'+aData.Version+'" found.');
+end;
+
+procedure TDBDigestAnalyzer.Analyse(aConfig: TDigestConfig; aData : TTestRunData);
+
+begin
+  FDB.RelSrcDir:=aConfig.relsrcdir;
+  FDB.TestSrcDir:=aConfig.testsrcdir;
+  if (aData.longlogfile<>'') and FileExists(aData.longlogfile) then
+    begin
+    LongLogFile:=TStringList.Create;
+    LongLogFile.LoadFromFile(aData.longlogfile);
+    end;
+  if not GetIDS(aConfig,aData) then
+    exit;
+  ProcessFile(aData.logfile,aData);
+  UpdateTestRun(aData);
+end;
+
+function TDBDigestAnalyzer.GetIDs(const aConfig : TDigestConfig; var aData : TTestRunData): Boolean;
+
+
+begin
+  Result := False;
+  aData.CPUID := FDB.GetCPUID(aData.CPU);
+  aData.OSID := FDB.GetOSID(aData.OS);
+  aData.VersionID := FDB.GetVersionID(aData.Version);
+  if aData.Category='' then
+    aData.Category:='Compiler/RTL';
+  aData.CategoryID := FDB.GetCategoryID(aData.Category);
+  aData.PlatformID := FDB.GetPlatformID(aData,True);
+  If (Round(aData.Date)=0) then
+    aData.Date:=Date;
+  Result:=CheckIDS(aData);
+  if not Result then
+    Exit;
+  aData.RunID:=FDB.GetRunID(aData);
+  If (aData.RunID<>-1) then
+    FDB.CleanTestRun(aData.RunID)
+  else
+    aData.RunID:=FDB.AddRun(aData);
+  Result:=aData.RunID<>-1;
+  if not Result then
+    begin
+    Verbose(V_Error,'Could not insert new testrun record!');
+    exit;
+    end;
+end;
+
+class procedure TDBDigestAnalyzer.ExtractTestFileName(var Line: string);
+
+Var I : integer;
+
+begin
+  I:=Pos(' ',Line);
+  If (I<>0) then
+    Line:=Copy(Line,1,I-1);
+end;
+
+class function TDBDigestAnalyzer.AnalyseLine(var Line: string; var Status: TTestStatus): Boolean;
+
+Var
+  TS : TTestStatus;
+
+begin
+  Result:=False;
+  For TS:=FirstStatus to LastStatus do
+    begin
+    Result:=Pos(StatusText[TS],Line)=1;
+    If Result then
+      begin
+      Status:=TS;
+      Delete(Line,1,Length(StatusText[TS]));
+      ExtractTestFileName(Line);
+      Break;
+      end;
+    end;
+end;
+
+(*
+
+ConfigAddStrings : Array [TConfigAddOpt] of string = (
+  'compilerdate',
+  'compilerfullversion',
+  'svncompilerrevision',
+  'svntestsrevision',
+  'svnrtlrevision',
+  'svnpackagesrevision'
+ );
+
+ConfigAddCols : Array [TConfigAddOpt] of string = (
+  'TU_COMPILERDATE',
+  'TU_COMPILERFULLVERSION',
+  'TU_SVNCOMPILERREVISION',
+  'TU_SVNTESTSREVISION',
+  'TU_SVNRTLREVISION',
+  'TU_SVNPACKAGESREVISION'
+ );
+
+*)
+
+
+
+const
+   SeparationLine = '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>';
+
+function TDBDigestAnalyzer.GetContentsFromLongLog(Line: String): String;
+
+  Function GetLongLogLine : String;
+  begin
+    Result:=LongLogFile[FCurLongLogLine];
+    Inc(FCurLongLogLine);
+  end;
+
+  Function HaveLongLogLine : Boolean; inline;
+  begin
+    Result:=FCurLongLogLine<LongLogFile.Count;
+  end;
+
+var
+  S : String;
+  IsFirst, IsFound : boolean;
+
+begin
+  Result:='';
+  IsFirst:=true;
+  IsFound:=false;
+  While HaveLongLogLine do
+    begin
+      S:=GetLongLogLine;
+      if FCurLongLogLine=1 then
+        begin
+          { At start of file there is a separation line }
+          if (pos(Line,S)=0) and (pos(SeparationLine,S)>=1) then
+            S:=GetLongLogLine
+        end;
+      if pos(Line,S)=1 then
+        begin
+          IsFound:=true;
+          while HaveLongLogLine do
+            begin
+              S:=GetLongLogLine;
+              { End of file marker }
+              if (Not HaveLongLogLine) or (pos(SeparationLine,S)=1) then
+                exit;
+              if length(Result)<MaxLogSize then
+                Result:=Result+S+LineEnding;
+              if pos(SeparationLine,S)>1 then
+                exit;
+            end;
+        end
+      else if IsFirst then
+        begin
+          Verbose(V_Warning,'Line "'+Line+'" not found as next "'+S+'"');
+          IsFirst:=false;
+        end;
+    end;
+  if not IsFound then
+    begin
+    Verbose(V_Warning,'Line "'+Line+'" not found');
+    FCurlongLogLine:=0; // Reset
+    end;
+end;
+
+function TDBDigestAnalyzer.GetLog(Line, FN: String): String;
+
+begin
+  if UseLongLog then
+    begin
+      Result:=GetContentsFromLongLog(Line);
+      exit;
+    end;
+  FN:=ChangeFileExt(FN,'.log');
+  { packages tests have ../ replaced by root/ }
+  if not FileExists(FN) and (Copy(FN,1,3)='../') then
+    FN:='root/'+Copy(FN,4,length(FN));
+  If FileExists(FN) then
+    Result:=GetFileContents(FN)
+  else
+    begin
+      Verbose(V_Warning,'File "'+FN+'" not found');
+      Result:='';
+    end;
+end;
+
+function TDBDigestAnalyzer.GetExecuteLog(Line, FN: String): String;
+
+begin
+  if UseLongLog then
+    begin
+      Result:=GetContentsFromLongLog(Line);
+      exit;
+    end;
+  FN:=ChangeFileExt(FN,'.elg');
+  { packages tests have ../ replaced by root/ }
+  if not FileExists(FN) and (Copy(FN,1,3)='../') then
+    FN:='root/'+Copy(FN,4,length(FN));
+  If FileExists(FN) then
+    Result:=GetFileContents(FN)
+  else
+    begin
+      Verbose(V_Warning,'File "'+FN+'" not found');
+      Result:='';
+    end;
+end;
+
+function TDBDigestAnalyzer.SaveTestResult(var aResult: TTestResultData): Boolean;
+
+var
+  lLast : TTestResultData;
+  lNewID : Int64;
+
+begin
+  Result:=False;
+  // Get last result for this test.
+  lLast:=FDB.GetLastTestResult(aResult.TestID,aResult.PlatformID);
+  if (aResult.Date<lLast.Date) then
+    exit; // Do not save earlier results
+  if not aResult.ResultDiffers(lLast) then
+    exit; // do not save identical results
+  // Need to save.
+  lNewID:=FDB.AddTestResult(aResult);
+  aResult.ID:=lNewId;
+  // Save current in lastresult
+  Result:=(LLast.ID<>lNewID);
+  if Result then
+    begin
+    // When new, save previous.
+    FDB.AddLastResult(aResult.TestID,aResult.PlatformID,lNewID);
+    FDB.AddPreviousResult(aResult.TestID,aResult.PlatformID,LLast.ID);
+    end;
+end;
+
+procedure TDBDigestAnalyzer.Processfile(const aFileName: String; var aData: TTestRunData);
+
+var
+  logfile : TStrings;
+  fullline,line,prevLine : string;
+  TS : TTestStatus;
+  lPrev,lResult : TTestResultData;
+
+begin
+  lPrev:=Default(TTestResultData);
+  lResult:=Default(TTestResultData);
+  // init data common to the whole testrun
+  lResult.RunID:=aData.RunID;
+  lResult.PlatFormID:=aData.PlatFormID;
+  lResult.Date:=aData.Date;
+  lPrev.RunID:=aData.RunID;
+  lPrev.PlatformID:=aData.PlatformID;
+  lPrev.TestID:=-1; // Init no test
+  lPrev.Date:=aData.Date;
+  for TS in TTestStatus do
+    aData.StatusCount[TS]:=0;
+  PrevLine:='';
+  logfile:=TStringList.Create;
+  try
+    LogFile.Capacity:=20000;
+    LogFile.LoadFromFile(aFileName);
+    For FullLine in LogFile do
+      begin
+        line:=fullline;
+        TS:=stFailedToCompile;
+        lResult.TestResult:=TS;
+        If not AnalyseLine(line,TS) then
+          begin
+          Inc(UnknownLines);
+          Verbose(V_Warning,'Unknown line: "'+line+'"');
+          end
+        else
+          begin
+          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
+            // We expect a log line with log result, save
+            Inc(aData.StatusCount[TS]);
+            lPrev.TestResult:=TS;
+            lPrev.TestID:=lResult.TestID;
+            PrevLine:=line;
+            end
+          else
+            begin
+            // 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
+                lResult.Log:='';
+              if SaveTestResult(lResult) then
+                Inc(aData.StatusCount[TS]);
+              end;
+            end
+          end
+      end;
+  finally
+    Logfile.Free;
+  end;
+end;
+
+procedure TDBDigestAnalyzer.UpdateTestRun(const aData : TTestRunData);
+
+begin
+  FDB.UpdateTestRun(aData);
+end;
+
+
+end.
+

tests/utils/tests.sql

@@ -1,138 +0,0 @@
-
-SET SQL_MODE="NO_AUTO_VALUE_ON_ZERO";
-
-CREATE TABLE TESTS (
-  T_ID   int(11) NOT NULL auto_increment,
-  T_NAME varchar(40) default NULL,
-  T_CPU varchar(20) default NULL,
-  T_OS varchar(30) default NULL,
-  T_VERSION varchar(10) default NULL,
-  T_ADDDATE date NOT NULL default '0000-00-00',
-  T_GRAPH char(1) NOT NULL default '-',
-  T_INTERACTIVE char(1) NOT NULL default '-',
-  T_RESULT int(11) NOT NULL default '0',
-  T_FAIL char(1) NOT NULL default '-',
-  T_RECOMPILE char(1) NOT NULL default '-',
-  T_NORUN char(1) NOT NULL default '-',
-  T_NEEDLIBRARY char(1) NOT NULL default '-',
-  T_KNOWNRUNERROR int(11) NOT NULL default '0',
-  T_KNOWN char(1) NOT NULL default '-',
-  T_NOTE varchar(255) default NULL,
-  T_DESCRIPTION text,
-  T_SOURCE text,
-  T_OPTS varchar(255) default NULL,
-  PRIMARY KEY  (T_ID),
-  UNIQUE KEY T_NAME (T_NAME)
-);
-
-CREATE TABLE TESTRESULTS (
-  TR_ID int(11) NOT NULL auto_increment,
-  TR_TESTRUN_FK int(11) NOT NULL default '0',
-  TR_TEST_FK int(11) default NULL,
-  TR_OK char(1) NOT NULL default '-',
-  TR_SKIP char(1) NOT NULL default '-',
-  TR_RESULT int(11) NOT NULL default '0',
-  TR_LOG text,
-  PRIMARY KEY  (TR_ID),
-  UNIQUE KEY TR_TESTCOMP (TR_TESTRUN_FK,TR_TEST_FK),
-  KEY I_TRTESTRUN (TR_TESTRUN_FK),
-  KEY I_TRTEST (TR_TEST_FK)
-);
-
-CREATE TABLE TESTRUN (
-  TU_ID int(11) NOT NULL auto_increment,
-  TU_DATE timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
-  TU_CPU_FK int(11) NOT NULL default '0',
-  TU_OS_FK int(11) NOT NULL default '0',
-  TU_VERSION_FK int(11) NOT NULL default '0',
-  TU_CATEGORY_FK int(11) NOT NULL default '1',
-  TU_FAILEDTOCOMPILE int(11) NOT NULL default '0',
-  TU_SUCCESSFULLYFAILED int(11) NOT NULL default '0',
-  TU_FAILEDTOFAIL int(11) NOT NULL default '0',
-  TU_SUCCESFULLYCOMPILED int(11) NOT NULL default '0',
-  TU_FAILEDTORUN int(11) NOT NULL default '0',
-  TU_KNOWNPROBLEM int(11) NOT NULL default '0',
-  TU_SUCCESSFULLYRUN int(11) NOT NULL default '0',
-  TU_SKIPPEDGRAPHTEST int(11) NOT NULL default '0',
-  TU_SKIPPEDINTERACTIVETEST int(11) NOT NULL default '0',
-  TU_KNOWNBUG int(11) NOT NULL default '0',
-  TU_COMPILERVERIONTOOLOW int(11) NOT NULL default '0',
-  TU_COMPILERVERIONTOOHIGH int(11) NOT NULL default '0',
-  TU_OTHERCPU int(11) NOT NULL default '0',
-  TU_OTHERTARGET int(11) NOT NULL default '0',
-  TU_UNIT int(11) NOT NULL default '0',
-  TU_SKIPPINGRUNTEST int(11) NOT NULL default '0',
-  TU_SUBMITTER varchar(128) NOT NULL default '',
-  TU_MACHINE varchar(128) NOT NULL default '',
-  TU_COMMENT varchar(255) NOT NULL default '',
-  PRIMARY KEY  (TU_ID),
-  UNIQUE KEY TU_OVERVIEW (TU_ID,TU_CPU_FK,TU_OS_FK,TU_VERSION_FK,TU_DATE),
-  KEY TU_IDATE (TU_DATE)
-);
-
-CREATE TABLE `TESTCATEGORY` (
-  TCAT_ID int(11) NOT NULL auto_increment,
-  TCAT_NAME varchar(20) default NULL,
-  PRIMARY KEY  (`TCAT_ID`),
-  UNIQUE KEY `TCAT_NAME` (`TCAT_NAME`)
-) AUTO_INCREMENT=3 ;
-
-CREATE TABLE TESTOS (
-  TO_ID int(11) NOT NULL auto_increment,
-  TO_NAME varchar(10) default NULL,
-  PRIMARY KEY  (`TO_ID`),
-  UNIQUE KEY `TR_INAME` (`TO_NAME`)
-) AUTO_INCREMENT=18 ;
-
-CREATE TABLE TESTVERSION (
-  TV_ID int(11) NOT NULL auto_increment,
-  TV_VERSION varchar(10) default NULL,
-  TV_RELEASEDATE timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
-  PRIMARY KEY  (TV_ID),
-  UNIQUE KEY TR_INAME (TV_VERSION)
-) AUTO_INCREMENT=7;
-
-CREATE TABLE TESTCPU (
-  TC_ID int(11) NOT NULL auto_increment,
-  TC_NAME varchar(10) default NULL,
-  PRIMARY KEY  (TC_ID),
-  UNIQUE KEY TC_INAME (TC_NAME)
-) AUTO_INCREMENT=10 ;
-
-INSERT INTO TESTCATEGORY VALUES (1, 'Compiler/RTL');
-INSERT INTO TESTCATEGORY VALUES (2, 'DB');
-
-INSERT INTO TESTCPU VALUES (1, 'i386');
-INSERT INTO TESTCPU VALUES (6, 'arm');
-INSERT INTO TESTCPU VALUES (3, 'm68k');
-INSERT INTO TESTCPU VALUES (4, 'sparc');
-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 TESTOS VALUES (1, 'linux');
-INSERT INTO TESTOS VALUES (2, 'win32');
-INSERT INTO TESTOS VALUES (3, 'go32v2');
-INSERT INTO TESTOS VALUES (4, 'os2');
-INSERT INTO TESTOS VALUES (5, 'freebsd');
-INSERT INTO TESTOS VALUES (6, 'netbsd');
-INSERT INTO TESTOS VALUES (7, 'openbsd');
-INSERT INTO TESTOS VALUES (8, 'amiga');
-INSERT INTO TESTOS VALUES (9, 'atari');
-INSERT INTO TESTOS VALUES (10, 'qnx');
-INSERT INTO TESTOS VALUES (11, 'beos');
-INSERT INTO TESTOS VALUES (12, 'solaris');
-INSERT INTO TESTOS VALUES (13, 'darwin');
-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 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');
-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');
-

tests/utils/testsuite.sql

@@ -0,0 +1,229 @@
+-- Database: testsuite
+
+-- DROP DATABASE IF EXISTS testsuite;
+
+CREATE DATABASE testsuite
+    WITH
+    OWNER = fpc
+    ENCODING = 'UTF8'
+    LC_COLLATE = 'en_GB.UTF-8'
+    LC_CTYPE = 'en_GB.UTF-8'
+    TABLESPACE = pg_default
+    template = 'template0'
+    CONNECTION LIMIT = -1
+    IS_TEMPLATE = False;
+    
+\c testsuite    
+
+CREATE SEQUENCE SEQ_TESTCATEGORY as INT start with 1;
+
+CREATE TABLE TESTCATEGORY (
+  TA_ID INT NOT NULL DEFAULT nextval('SEQ_TESTCATEGORY'),
+  TA_NAME VARCHAR(20),
+  constraint PK_TESTCATEGORY PRIMARY KEY (TA_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTCATEGORYNAME ON TESTCATEGORY(TA_NAME);
+
+CREATE SEQUENCE SEQ_TESTCPU as INT start with 1;
+
+CREATE TABLE TESTCPU (
+  TC_ID INT NOT NULL DEFAULT nextval('SEQ_TESTCPU'),
+  TC_NAME varchar(10),
+  constraint PK_TESTCPU PRIMARY KEY (TC_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTCPU ON TESTCPU(TC_NAME);
+
+CREATE SEQUENCE SEQ_TESTOS as INT start with 1;
+
+CREATE TABLE TESTOS (
+  TO_ID INT DEFAULT nextval('SEQ_TESTOS'),
+  TO_NAME varchar(10),
+  constraint PK_TESTOS PRIMARY KEY (TO_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTOS ON TESTOS(TO_NAME);
+
+CREATE SEQUENCE SEQ_TESTVERSION as INT start with 1;
+
+CREATE TABLE TESTVERSION (
+  TV_ID int NOT NULL default nextval('SEQ_TESTVERSION'),
+  TV_VERSION varchar(10),
+  TV_RELEASEDATE date DEFAULT CURRENT_TIMESTAMP,
+  constraint PK_TESTVERSION PRIMARY KEY (TV_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTVERSION ON TESTVERSION(TV_VERSION);
+
+CREATE SEQUENCE SEQ_TESTS as INT start with 1;
+
+CREATE TABLE TESTS (
+  T_ID int NOT NULL default nextval('SEQ_TESTS'),
+  T_NAME varchar(127),
+  T_CPU varchar(127),
+  T_OS varchar(127),
+  T_VERSION varchar(10),
+  T_ADDDATE date NOT NULL,
+  T_GRAPH boolean NOT NULL default 'f',
+  T_INTERACTIVE boolean NOT NULL default 'f',
+  T_RESULT int NOT NULL default '0',
+  T_FAIL boolean NOT NULL default 'f',
+  T_RECOMPILE boolean NOT NULL default 'f',
+  T_NORUN boolean NOT NULL default 'f',
+  T_NEEDLIBRARY boolean NOT NULL default 'f',
+  T_KNOWNRUNERROR INT NOT NULL default 0,
+  T_KNOWN boolean NOT NULL default 'f',
+  T_NOTE varchar(255) default NULL,
+  T_DESCRIPTION text,
+  T_SOURCE text,
+  T_OPTS varchar(255) default NULL,
+  constraint PK_TESTS PRIMARY KEY  (T_ID)
+);
+
+CREATE UNIQUE INDEX UDX_TESTS ON TESTS(T_NAME);
+
+CREATE SEQUENCE SEQ_TESTPLATFORM as INT start with 1;
+
+CREATE TABLE TESTPLATFORM (
+  TP_ID INT NOT NULL default nextval('SEQ_TESTPLATFORM'),
+  TP_CPU_FK INT NOT NULL,
+  TP_OS_FK INT NOT NULL,
+  TP_VERSION_FK INT NOT NULL,
+  TP_CATEGORY_FK int NOT NULL,
+  TP_CONFIG VARCHAR(255) NOT NULL,
+  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);
+CREATE INDEX IDX_TESTPLATFORMRELATIONS ON TESTPLATFORM(TP_CPU_FK,TP_OS_FK,TP_VERSION_FK,TP_CATEGORY_FK);
+
+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,
+  TU_SUCCESFULLYCOMPILED int NOT NULL default 0,
+  TU_FAILEDTORUN int NOT NULL default 0,
+  TU_KNOWNPROBLEM int NOT NULL default 0,
+  TU_SUCCESSFULLYRUN int NOT NULL default 0,
+  TU_SKIPPEDGRAPHTEST int NOT NULL default 0,
+  TU_SKIPPEDINTERACTIVETEST int NOT NULL default 0,
+  TU_KNOWNBUG int NOT NULL default 0,
+  TU_COMPILERVERIONTOOLOW int NOT NULL default 0,
+  TU_COMPILERVERIONTOOHIGH int NOT NULL default 0,
+  TU_OTHERCPU int NOT NULL default 0,
+  TU_OTHERTARGET int NOT NULL default 0,
+  TU_UNIT int NOT NULL default 0,
+  TU_SKIPPINGRUNTEST int NOT NULL default 0,
+  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);
+
+-- Create relations
+
+ALTER TABLE testplatform ADD CONSTRAINT fk_plaform_os FOREIGN KEY (tp_os_fk) REFERENCES testos (to_id);
+ALTER TABLE testplatform ADD CONSTRAINT fk_plaform_cpu FOREIGN KEY (tp_cpu_fk) REFERENCES testcpu (tc_id);
+ALTER TABLE testplatform ADD CONSTRAINT fk_plaform_version FOREIGN KEY (tp_version_fk) REFERENCES testversion (tv_id);
+ALTER TABLE testplatform ADD CONSTRAINT fk_plaform_category FOREIGN KEY (tp_category_fk) REFERENCES testcategory (ta_id);
+ALTER TABLE testrun ADD CONSTRAINT fk_run_platform FOREIGN KEY (tu_platform_fk) REFERENCES testplatform (tp_id);
+ALTER TABLE testresults ADD CONSTRAINT fk_results_run FOREIGN KEY (tr_testrun_fk) REFERENCES testrun (tu_id);
+ALTER TABLE testresults ADD CONSTRAINT fk_results_test FOREIGN KEY (tr_test_fk) REFERENCES tests (t_id);
+
+-- Insert default data
+
+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');
+INSERT INTO TESTCPU VALUES (3, 'm68k');
+INSERT INTO TESTCPU VALUES (4, 'sparc');
+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');
+INSERT INTO TESTOS VALUES (3, 'go32v2');
+INSERT INTO TESTOS VALUES (4, 'os2');
+INSERT INTO TESTOS VALUES (5, 'freebsd');
+INSERT INTO TESTOS VALUES (6, 'netbsd');
+INSERT INTO TESTOS VALUES (7, 'openbsd');
+INSERT INTO TESTOS VALUES (8, 'amiga');
+INSERT INTO TESTOS VALUES (9, 'atari');
+INSERT INTO TESTOS VALUES (10, 'qnx');
+INSERT INTO TESTOS VALUES (11, 'beos');
+INSERT INTO TESTOS VALUES (12, 'solaris');
+INSERT INTO TESTOS VALUES (13, 'darwin');
+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');
+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/defaults.sql

@@ -1,61 +0,0 @@
--- MySQL dump 8.22
---
--- Host: localhost    Database: TESTSUITE
----------------------------------------------------------
--- Server version	3.23.52-log
-
---
--- Dumping data for table 'TESTCPU'
---
-
-
-INSERT INTO TESTCPU VALUES (1,'i386');
-INSERT INTO TESTCPU VALUES (6,'arm');
-INSERT INTO TESTCPU VALUES (3,'m68k');
-INSERT INTO TESTCPU VALUES (4,'sparc');
-INSERT INTO TESTCPU VALUES (5,'powerpc');
-INSERT INTO TESTCPU VALUES (7,'x86_64');
-INSERT INTO TESTCPU VALUES (0,'All');
-
---
--- Dumping data for table 'TESTOS'
---
-
-
-INSERT INTO TESTOS VALUES (1,'linux');
-INSERT INTO TESTOS VALUES (2,'win32');
-INSERT INTO TESTOS VALUES (3,'go32v2');
-INSERT INTO TESTOS VALUES (4,'os2');
-INSERT INTO TESTOS VALUES (5,'freebsd');
-INSERT INTO TESTOS VALUES (6,'netbsd');
-INSERT INTO TESTOS VALUES (7,'openbsd');
-INSERT INTO TESTOS VALUES (8,'amiga');
-INSERT INTO TESTOS VALUES (9,'atari');
-INSERT INTO TESTOS VALUES (10,'qnx');
-INSERT INTO TESTOS VALUES (11,'beos');
-INSERT INTO TESTOS VALUES (12,'sunos');
-INSERT INTO TESTOS VALUES (13,'darwin');
-INSERT INTO TESTOS VALUES (14,'macos');
-INSERT INTO TESTOS VALUES (0,'All');
-
-
---
--- Dumping data for table 'TESTVERSION'
---
-
-
-INSERT INTO TESTVERSION VALUES (1,'1.0.6',20021220154940);
-INSERT INTO TESTVERSION VALUES (2,'1.0.7',20021220154940);
-INSERT INTO TESTVERSION VALUES (3,'1.0.8',20021220154940);
-INSERT INTO TESTVERSION VALUES (4,'1.1.0',20021220154940);
-INSERT INTO TESTVERSION VALUES (5,'1.1',20021220155122);
-INSERT INTO TESTVERSION VALUES (6,'1.0.10',20030601155122);
-INSERT INTO TESTVERSION VALUES (7,'1.9.0',20031103164832);
-INSERT INTO TESTVERSION VALUES (8,'1.9.1',20031103165215);
-INSERT INTO TESTVERSION VALUES (9,'1.9.2',20040104182007);
-INSERT INTO TESTVERSION VALUES (10,'1.9.3',20040104182038);
-INSERT INTO TESTVERSION VALUES (11,'1.0.11',20040225131159);
-INSERT INTO TESTVERSION VALUES (12,'1.9.4',20040531101027);
-INSERT INTO TESTVERSION VALUES (13,'1.9.5',20040531101036);
-INSERT INTO TESTVERSION VALUES (0,'All',20040922232934);
-

tests/utils/testsuite/testsuite.sql

@@ -1,94 +0,0 @@
---
--- Table structure for table 'TESTCPU'
---
-
-CREATE TABLE TESTCPU (
-  TC_ID int(11) NOT NULL auto_increment,
-  TC_NAME varchar(10) default NULL,
-  PRIMARY KEY  (TC_ID),
-  UNIQUE KEY TC_INAME (TC_NAME)
-) TYPE=MyISAM;
-
---
--- Table structure for table 'TESTOS'
---
-
-CREATE TABLE TESTOS (
-  TO_ID int(11) NOT NULL auto_increment,
-  TO_NAME varchar(10) default NULL,
-  PRIMARY KEY  (TO_ID),
-  UNIQUE KEY TR_INAME (TO_NAME)
-) TYPE=MyISAM;
-
---
--- Table structure for table 'TESTRESULTS'
---
-CREATE TABLE TESTRUN (
-  TU_ID int(11) NOT NULL auto_increment,
-  TU_DATE timestamp(14) NOT NULL,
-  TU_CPU_FK int(11) NOT NULL,
-  TU_OS_FK int(11) NOT NULL,
-  TU_VERSION_FK int(11) NOT NULL,
-  PRIMARY KEY  (TU_ID),
-  KEY TU_IDATE (TU_DATE),
-  UNIQUE TU_UNIQUE(TU_DATE,TU_CPU_FK,TU_OS_FK,TU_VERSION_FK)
-) TYPE=MyISAM;
-
-
---
--- Table structure for table 'TESTRESULTS'
---
-CREATE TABLE TESTRESULTS (
-  TR_ID int(11) NOT NULL auto_increment,
-  TR_TESTRUN_FK int(11) NOT NULL,
-  TR_TEST_FK int(11),
-  TR_OK char(1) NOT NULL default '-',
-  TR_SKIP char(1) NOT NULL default '-',
-  TR_RESULT int(11) NOT NULL default '0',
-  TR_LOG text,
-  PRIMARY KEY  (TR_ID),
-  INDEX I_TRTESTRUN (TR_TESTRUN_FK),
-  INDEX I_TRTEST (TR_TEST_FK)
-) TYPE=MyISAM;
-
---
--- Table structure for table 'TESTS'
---
-
-CREATE TABLE TESTS (
-  T_ID int(11) NOT NULL auto_increment,
-  T_NAME varchar(80) NOT NULL default '',
-  T_FULLNAME varchar(255) NOT NULL default '',
-  T_CPU varchar(20) default NULL,
-  T_OS varchar(30) default NULL,
-  T_VERSION varchar(10) default NULL,
-  T_ADDDATE date NOT NULL default '0000-00-00',
-  T_GRAPH char(1) NOT NULL default '-',
-  T_INTERACTIVE char(1) NOT NULL default '-',
-  T_RESULT int(11) NOT NULL default '0',
-  T_FAIL char(1) NOT NULL default '-',
-  T_RECOMPILE char(1) NOT NULL default '-',
-  T_NORUN char(1) NOT NULL default '-',
-  T_NEEDLIBRARY char(1) NOT NULL default '-',
-  T_KNOWNRUNERROR int(11) NOT NULL default '0',
-  T_KNOWN char(1) NOT NULL default '-',
-  T_NOTE varchar(255) default NULL,
-  T_DESCRIPTION text,
-  T_SOURCE text,
-  T_OPTS varchar(255) default NULL,
-  PRIMARY KEY  (T_ID),
-  UNIQUE KEY TESTNAME (T_NAME)
-) TYPE=MyISAM;
-
---
--- Table structure for table 'TESTVERSION'
---
-
-CREATE TABLE TESTVERSION (
-  TV_ID int(11) NOT NULL auto_increment,
-  TV_VERSION varchar(10) default NULL,
-  TV_RELEASEDATE timestamp(14) NOT NULL,
-  PRIMARY KEY  (TV_ID),
-  UNIQUE KEY TR_INAME (TV_VERSION)
-) TYPE=MyISAM;
-

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,49 @@ 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;
+    Date : TDateTime;
+    function ResultDiffers(aResult : TTestResultData; CompareLog : Boolean = False) : Boolean;
+  end;
+
+
 Const
   DoVerbose : boolean = false;
   DoSQL     : boolean = false;
@@ -63,8 +107,9 @@ procedure TrimB(var s:string);
 procedure TrimE(var s:string);
 function upper(const s : string) : string;
 procedure Verbose(lvl:TVerboseLevel;const s:string);
-function GetConfig(const fn:string;var r:TConfig):boolean;
+function GetConfig(const logprefix,fn:string;var r:TConfig):boolean;
 Function GetFileContents (FN : String) : String;
+function GetUnitTestConfig(const logprefix,fn,SrcDir: string; var r : TConfig) : Boolean;
 
 const
 { Constants used in IsAbsolute function }
@@ -86,6 +131,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 +180,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 +208,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 }
@@ -244,6 +277,7 @@ begin
         halt(0);
       end;
   end;
+  Flush(output);
 end;
 
 procedure TrimB(var s:string);
@@ -265,22 +299,23 @@ 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;
+function GetConfig(const logprefix,fn:string;var r:TConfig):boolean;
 var
   t : text;
   part,code : integer;
   l : longint;
   p : sizeint;
-  s,res,tmp : string;
+  s,res: string;
 
   function GetEntry(const entry:string):boolean;
   var
@@ -525,4 +560,81 @@ begin
   Close(F);
 end;
 
+function GetUnitTestConfig(const logprefix,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,logprefix+'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.ResultDiffers(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/tcanalyst.pas

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

tests/utils/unittests/tcsetup.pas

@@ -0,0 +1,221 @@
+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 TearDown;
+    class procedure ClearTable(const aTable : string);
+    class procedure ClearAllTables;
+    class function IDQuery(const aSQL : String) : Int64;
+    class procedure ExecAndCommit(Qry: TSQLQuery);
+    class procedure ExecSQL(const aSQL: String);
+    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.TearDown;
+begin
+  FreeAndNil(SQL);
+  FreeAndNil(Conn);
+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 procedure TDBHelper.ClearAllTables;
+begin
+  ClearTable('TESTOS');
+  ClearTable('TESTCPU');
+  ClearTable('TESTCATEGORY');
+  ClearTable('TESTVERSION');
+  ClearTable('TESTPLATFORM');
+  ClearTable('TESTRUN');
+  ClearTable('TESTS');
+  ClearTable('TESTRESULTS');
+  ClearTable('TESTLASTRESULTS');
+  ClearTable('TESTPREVIOUSRESULTS');
+end;
+
+class function TDBHelper.IDQuery(const aSQL: String): Int64;
+
+var
+  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
+  TDBHelper.TearDown;
+end;
+
+
+end.
+

tests/utils/unittests/tctestsql.pas

@@ -0,0 +1,530 @@
+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 }
+
+  { TTestBaseSQLCase }
+
+  TTestBaseSQLCase = class(TTestCase)
+  Protected
+    function CreateResultData(out aData: TTestRunData; out aResult: TTestResultData; DateOffset: Integer = 0): Int64;
+    function PreparePlatform(var aData: TTestRunData): Integer;
+    procedure CreateSource(const aFileName : String);
+    procedure DeleteSource(const aFileName: String);
+    procedure AssertTestRunData(aQry: TSQLQuery; aData: TTestRunData);
+    function GetSQL: TTestSQL; virtual; abstract;
+    property SQL : TTestSQL Read GetSQL;
+  end;
+
+  TTestSQLCase = class(TTestBaseSQLCase)
+  const
+    SQLTestResultFilter = '(TR_ID=%d) and (TR_TESTRUN_FK=%d) and (TR_TEST_FK=%d) and (TR_OK=''%s'') and (TR_SKIP=''%s'') and (TR_RESULT=%d) and (TR_LOG=''%s'')';
+  protected
+    function GetSQL: TTestSQL; override;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  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 TestAddPreviousResult;
+    Procedure TestAddPreviousResultTwice;
+    procedure TestGetCPUID;
+    procedure TestGetOSID;
+    procedure TestGetCategoryID;
+    procedure TestGetVersionID;
+    procedure TestGetTestID;
+    procedure TestGetRunID;
+  end;
+
+
+
+implementation
+
+uses tcsetup;
+
+{ TTestBaseSQLCase }
+
+
+procedure TTestBaseSQLCase.DeleteSource(const aFileName: String);
+begin
+  if FileExists(aFilename+'.pp') then
+    if not DeleteFile(aFilename+'.pp') then
+      Fail('Failed to delete '+aFileName+'.pp');
+end;
+
+procedure TTestBaseSQLCase.CreateSource(const aFileName: String);
+var
+  Src : TStrings;
+begin
+  Src:=TStringList.Create;
+  try
+    Src.Add('program '+aFileName+';');
+    Src.Add('begin');
+    Src.Add('end.');
+    Src.SaveToFile(afileName+'.pp');
+  finally
+    Src.Free;
+  end;
+end;
+
+function TTestBaseSQLCase.PreparePlatform(var aData : TTestRunData) : Integer;
+
+begin
+  aData.CategoryID:=SQL.GetCategoryID('x');
+  if aData.CategoryID=-1 then
+    aData.CategoryID:=SQL.AddCategory('x');
+
+  aData.OSID:=SQL.GetOSID('y');
+  if aData.OSID=-1 then
+    aData.OSID:=SQL.AddOS('y');
+
+  aData.CPUID:=SQL.GetCPUID('z');
+  if aData.CPUID=-1 then
+    aData.CPUID:=SQL.AddCPU('z');
+
+  aData.VersionID:=SQL.GetVersionID('w');
+  if aData.VersionID=-1 then
+    aData.VersionID:=SQL.AddVersion('w',Date);
+
+  aData.config:='v';
+  Result:=SQL.GetPlatformID(aData,False);
+  if Result=-1 then
+    Result:=SQL.AddPlatform(aData);
+end;
+
+procedure TTestBaseSQLCase.AssertTestRunData(aQry : TSQLQuery; aData : TTestRunData);
+
+var
+  St : TTestStatus;
+
+begin
+  With aQry,aData do
+    begin
+    AssertEquals('Date',DATE,FieldByName('TU_DATE').AsDateTime);
+    AssertEquals('Platform',PlatformID,FieldByName('TU_PLATFORM_FK').AsInteger);
+    AssertEquals('Machine',Machine,FieldByName('TU_MACHINE').AsString);
+    AssertEquals('Submitter',Submitter,FieldByName('TU_SUBMITTER').AsString);
+    For St in TTestStatus do
+      AssertEquals(StatusText[St],StatusCount[st],FieldByName(SQLField[ST]).AsInteger);
+    AssertEquals('CompilerDate',CompilerDate,FieldByName('TU_COMPILERDATE').AsString);
+    AssertEquals('CompilerFullVersion',CompilerFullVersion,FieldByName('TU_COMPILERFULLVERSION').AsString);
+    AssertEquals('CompilerRevision',CompilerRevision,FieldByName('TU_COMPILERREVISION').AsString);
+    AssertEquals('TestsRevision',TestsRevision,FieldByName('TU_TESTSREVISION').AsString);
+    AssertEquals('RTLRevision',RTLRevision,FieldByName('TU_RTLREVISION').AsString);
+    AssertEquals('PackagesRevision',PackagesRevision,FieldByName('TU_PACKAGESREVISION').AsString);
+    end;
+end;
+
+function TTestBaseSQLCase.CreateResultData(out aData: TTestRunData; out aResult: TTestResultData; DateOffset: Integer): Int64;
+
+begin
+  aData:=Default(TTestRunData);
+  aData.PlatformID:=PreparePlatform(aData);
+  aData.Date:=Date-DateOffset;
+  aData.RunID:=SQL.AddRun(aData);
+  aResult:=Default(TTestResultData);
+  aResult.RunID:=aData.RunID;
+  aResult.PlatformID:=aData.PlatformID;
+  aResult.Date:=Date-DateOffset;
+  CreateSource('x');
+  if SQL.GetTestID('x.pp')=-1 then
+    aResult.TestID:=SQL.AddTest('x.pp',False);
+  aResult.TestResult:=stSuccessCompilationFailed;
+  aResult.Log:='xyz';
+  With aData do
+    begin
+    Result:=SQL.AddTestResult(aResult);
+    aResult.ID:=Result;
+    end;
+end;
+
+
+{ TTestSQLCase }
+
+procedure TTestSQLCase.TestHookUp;
+begin
+  AssertEquals('Empty testos',0,TDBHelper.CountRecords('TESTOS'));
+  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;
+
+
+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.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;
+
+
+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,1);
+  AssertTrue('Add',SQL.AddLastResult(lResult.TestID,lData.PlatformID,lID));
+  lResult2:=SQL.GetLastTestResult(lResult.TestID,lData.PlatformID);
+  AssertEquals('ID',lID,lResult2.ID);
+  AssertEquals('Run',lResult.RunID,lResult2.RunID);
+  AssertTrue('Status',lResult.TestResult=lResult2.TestResult);
+  AssertEquals('Log',lResult.Log,lResult2.Log);
+  AssertEquals('Date',Date-1,lResult2.Date);
+end;
+
+procedure TTestSQLCase.TestAddPreviousResult;
+var
+  lData : TTestRunData;
+  lResult : TTestResultData;
+  lID : Int64;
+  flt : String;
+
+begin
+  lID:=CreateResultData(lData,lResult);
+  AssertTrue('Add',SQL.AddPreviousResult(lResult.TestID,lData.PlatformID,lID));
+  flt:=Format('(TPR_TEST_FK=%d) and (TPR_PLATFORM_FK=%d) and (TPR_TESTRESULTS_FK=%d)',[lResult.TestID,lData.PlatformID,lID]);
+  AssertEquals('Result',1,TDBHelper.CountRecords('TESTPREVIOUSRESULTS',Flt));
+end;
+
+procedure TTestSQLCase.TestAddPreviousResultTwice;
+var
+  lData : TTestRunData;
+  lResult : TTestResultData;
+  lID,lID2 : Integer;
+  flt : string;
+begin
+  lID:=CreateResultData(lData,lResult,1);
+  AssertTrue('Add',SQL.AddPreviousResult(lResult.TestID,lData.PlatformID,lID));
+  lID2:=CreateResultData(lData,lResult,0);
+  AssertTrue('Add',SQL.AddPreviousResult(lResult.TestID,lData.PlatformID,lID2));
+  flt:=Format('(TPR_TEST_FK=%d) and (TPR_PLATFORM_FK=%d) and (TPR_TESTRESULTS_FK=%d)',[lResult.TestID,lData.PlatformID,lID2]);
+  AssertEquals('Result',1,TDBHelper.CountRecords('TESTPREVIOUSRESULTS',Flt));
+end;
+
+procedure TTestSQLCase.TestUpdateRun;
+
+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.ClearAllTables;
+  SQL.TestSrcDir:='./';
+end;
+
+procedure TTestSQLCase.TearDown;
+begin
+  TDBHelper.MaybeRollback;
+  DeleteSource('x');
+end;
+
+
+
+initialization
+  RegisterTestDecorator(TDBDecorator,TTestSQLCase);
+
+end.
+

tests/utils/unittests/testdbdigest.lpi

@@ -0,0 +1,82 @@
+<?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>
+      <Unit>
+        <Filename Value="tcanalyst.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, tcanalyst;
+
+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