* Reworked testsuite database

tests/utils/Makefile

@@ -2410,15 +2410,15 @@ include fpcmake.loc
 endif
 .NOTPARALLEL:
 utils: all
-dbconfig$(SRCEXEEXT): dbconfig.pp teststr$(PPUEXT) testu$(PPUEXT) tresults$(PPUEXT) dbtests$(PPUEXT)
+dbconfig$(SRCEXEEXT): dbconfig.pp tsstring$(PPUEXT) tsutils$(PPUEXT) tstypes$(PPUEXT) tsdb$(PPUEXT)
 	$(COMPILER) $<
-dbdigest$(SRCEXEEXT): dbdigest.pp digestanalyst$(PPUEXT) teststr$(PPUEXT) testu$(PPUEXT) tresults$(PPUEXT) dbtests$(PPUEXT)
+dbdigest$(SRCEXEEXT): dbdigest.pp digestanalyst$(PPUEXT) tsstring$(PPUEXT) tsutils$(PPUEXT) tstypes$(PPUEXT) tsdb$(PPUEXT)
 	$(COMPILER) $<
-digest$(SRCEXEEXT): digest.pp teststr$(PPUEXT)
+digest$(SRCEXEEXT): digest.pp tsstring$(PPUEXT)
 	$(COMPILER) $<
 dosbox/dosbox_wrapper$(SRCEXEEXT): dosbox/dosbox_wrapper.pas  
 	$(COMPILER) -FE./dosbox $<
-dotest$(SRCEXEEXT): dotest.pp bench$(PPUEXT) teststr$(PPUEXT) redir$(PPUEXT) testu$(PPUEXT)
+dotest$(SRCEXEEXT): dotest.pp bench$(PPUEXT) tsstring$(PPUEXT) redir$(PPUEXT) tsutils$(PPUEXT)
 	$(COMPILER) $<
 fptime$(SRCEXEEXT): fptime.pp bench$(PPUEXT)
 	$(COMPILER) $<

tests/utils/Makefile.fpc

@@ -34,19 +34,19 @@ endif
 
 utils: all
 
-dbconfig$(SRCEXEEXT): dbconfig.pp teststr$(PPUEXT) testu$(PPUEXT) tresults$(PPUEXT) dbtests$(PPUEXT)
+dbconfig$(SRCEXEEXT): dbconfig.pp tsstring$(PPUEXT) tsutils$(PPUEXT) tstypes$(PPUEXT) tsdb$(PPUEXT)
         $(COMPILER) $<
 
-dbdigest$(SRCEXEEXT): dbdigest.pp digestanalyst$(PPUEXT) teststr$(PPUEXT) testu$(PPUEXT) tresults$(PPUEXT) dbtests$(PPUEXT)
+dbdigest$(SRCEXEEXT): dbdigest.pp digestanalyst$(PPUEXT) tsstring$(PPUEXT) tsutils$(PPUEXT) tstypes$(PPUEXT) tsdb$(PPUEXT)
         $(COMPILER) $<
 
-digest$(SRCEXEEXT): digest.pp teststr$(PPUEXT)
+digest$(SRCEXEEXT): digest.pp tsstring$(PPUEXT)
         $(COMPILER) $<
 
 dosbox/dosbox_wrapper$(SRCEXEEXT): dosbox/dosbox_wrapper.pas  
 	$(COMPILER) -FE./dosbox $<
 
-dotest$(SRCEXEEXT): dotest.pp bench$(PPUEXT) teststr$(PPUEXT) redir$(PPUEXT) testu$(PPUEXT)
+dotest$(SRCEXEEXT): dotest.pp bench$(PPUEXT) tsstring$(PPUEXT) redir$(PPUEXT) tsutils$(PPUEXT)
         $(COMPILER) $<
 
 fptime$(SRCEXEEXT): fptime.pp bench$(PPUEXT)

tests/utils/dbadd.lpi

@@ -4,14 +4,23 @@
     <Version Value="12"/>
     <General>
       <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
+        <SaveJumpHistory Value="False"/>
+        <SaveFoldState Value="False"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <Title Value="Digest add value Application"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
+    <CustomData Count="3">
+      <Item0 Name="OpenAPIBase"/>
+      <Item1 Name="OpenAPIConfig"/>
+      <Item2 Name="OpenAPIFile"/>
+    </CustomData>
     <BuildModes>
       <Item Name="Default" Default="True"/>
     </BuildModes>
@@ -28,7 +37,15 @@
         <IsPartOfProject Value="True"/>
       </Unit>
       <Unit>
-        <Filename Value="dbtests.pp"/>
+        <Filename Value="tsdb.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="tsutils.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="tstypes.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit>
     </Units>

tests/utils/dbadd.lpr

@@ -5,7 +5,7 @@ program dbadd;
 {$modeswitch typehelpers}
 
 uses
-  Classes, SysUtils, CustApp, dbtests, inifiles;
+  Classes, SysUtils, CustApp, tsdb, tsutils, inifiles;
 
 type
   TValueType = (vtCategory,vtCPU,vtOS,vtVersion);

tests/utils/dbconfig.pp

@@ -1,600 +0,0 @@
-{
-    This file is part of the Free Pascal test suite.
-    Copyright (c) 2002 by the Free Pascal development team.
-
-    This program updates TESTCONFIG anf TESTRUNHISTORY tables
-    with the last tests run.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-{$h+}
-{$ifndef win32}
-  {$linklib pthread}
-{$endif}
-
-program dbconfig;
-
-uses
-  sysutils,teststr,testu,tresults,
-  sqldb,dbtests;
-
-
-Var
-  StatusCount : Array[TTestStatus] of Integer;
-  UnknownLines : integer;
-
-
-Procedure ExtractTestFileName(Var Line : string);
-
-Var I : integer;
-
-begin
-  I:=Pos(' ',Line);
-  If (I<>0) then
-    Line:=Copy(Line,1,I-1);
-end;
-
-Function Analyse(Var Line : string; Var Status : TTestStatus) : Boolean;
-
-Var
-  TS : TTestStatus;
-
-begin
-  Result:=False;
-  For TS:=FirstStatus to LastStatus do
-    begin
-    Result:=Pos(StatusText[TS],Line)=1;
-    If Result then
-      begin
-      Status:=TS;
-      Delete(Line,1,Length(StatusText[TS]));
-      ExtractTestFileName(Line);
-      Break;
-      end;
-    end;
-end;
-
-Type
-
-TConfigOpt = (
-  coDatabaseName,
-  coHost,
-  coUserName,
-  coPassword,
-  coPort,
-  coLogFile,
-  coLongLogFile,
-  coOS,
-  coCPU,
-  coCategory,
-  coVersion,
-  coDate,
-  coSubmitter,
-  coMachine,
-  coComment,
-  coTestSrcDir,
-  coRelSrcDir,
-  coVerbose,
-  coOffset
- );
-
-{ 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',
-  'offset'
-);
-
-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 }
- 'O'  { coOffset }
-);
-
-ConfigAddStrings : Array [TConfigAddOpt] of string = (
-  'compilerdate',
-  'compilerfullversion',
-  'svncompilerrevision',
-  'svntestsrevision',
-  'svnrtlrevision',
-  'svnpackagesrevision'
- );
-
-ConfigAddCols : Array [TConfigAddOpt] of string = (
-  'TU_COMPILERDATE',
-  'TU_COMPILERFULLVERSION',
-  'TU_SVNCOMPILERREVISION',
-  'TU_SVNTESTSREVISION',
-  'TU_SVNRTLREVISION',
-  'TU_SVNPACKAGESREVISION'
- );
-
-
-Var
-  TestOS,
-  TestCPU,
-  TestVersion,
-  TestCategory,
-  DatabaseName,
-  HostName,
-  UserName,
-  Password,
-  Port,
-  LongLogFileName,
-  LogFileName,
-  Submitter,
-  Machine,
-  Comment,
-  OffsetString : String;
-  TestDate : TDateTime;
-  TestCompilerDate,
-  TestCompilerFullVersion,
-  TestSvnCompilerRevision,
-  TestSvnTestsRevision,
-  TestSvnRTLRevision,
-  TestSvnPackagesRevision : String;
-  ConfigID : Integer;
-
-Procedure SetAddOpt (O : TConfigAddOpt; Value : string);
-begin
-  Case O of
-    coCompilerDate:
-      TestCompilerDate:=Value;
-    coCompilerFullVersion:
-      TestCompilerFullVersion:=Value;
-    coSvnCompilerRevision:
-      TestSvnCompilerRevision:=Value;
-    coSvnTestsRevision:
-      TestSvnTestsRevision:=Value;
-    coSvnRTLRevision:
-      TestSvnRTLRevision:=Value;
-    coSvnPackagesRevision:
-      TestSvnPackagesRevision:=Value;
-  end;
-end;
-
-Procedure SetOpt (O : TConfigOpt; Value : string);
-var
-  year,month,day,min,hour : word;
-begin
-  Case O of
-    coDatabaseName : DatabaseName:=Value;
-    coHost         : HostName:=Value;
-    coUserName     : UserName:=Value;
-    coPassword     : Password:=Value;
-    coPort         : Port:=Value;
-    coLogFile      : LogFileName:=Value;
-    coLongLogFile  : LongLogFileName:=Value;
-    coOS           : TestOS:=Value;
-    coCPU          : TestCPU:=Value;
-    coCategory     : TestCategory:=Value;
-    coVersion      : TestVersion:=Value;
-    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;
-    coOffset       : OffsetString:=Value;
-    coVerbose      : DoVerbose:=true;
-    coTestSrcDir   :
-      begin
-        TestSrcDir:=Value;
-	if (TestSrcDir<>'') and (TestSrcDir[length(TestSrcDir)]<>'/') then
-	  TestSrcDir:=TestSrcDir+'/';
-      end;
-    coRelSrcDir   :
-      begin
-        RelSrcDir:=Value;
-	if (RelSrcDir<>'') and (RelSrcDir[length(RelSrcDir)]<>'/') then
-	  RelSrcDir:=RelSrcDir+'/';
-	if (RelSrcDir<>'') and (RelSrcDir[1]='/') then
-	  RelSrcDir:=copy(RelSrcDir,2,length(RelSrcDir)-1);
-      end;
-  end;
-end;
-
-Function ProcessOption(S: String) : Boolean;
-
-Var
-  N : String;
-  I : Integer;
-  co : TConfigOpt;
-  coa : TConfigAddOpt;
-
-begin
-  Verbose(V_DEBUG,'Processing option: '+S);
-  I:=Pos('=',S);
-  Result:=(I<>0);
-  If Result then
-    begin
-    N:=Copy(S,1,I-1);
-    Delete(S,1,I);
-    For co:=low(TConfigOpt) to high(TConfigOpt) do
-      begin
-      Result:=CompareText(ConfigStrings[co],N)=0;
-      If Result then
-        begin
-          SetOpt(co,S);
-          Exit;
-        end;
-      end;
-    For coa:=low(TConfigAddOpt) to high(TConfigAddOpt) do
-      begin
-      Result:=CompareText(ConfigAddStrings[coa],N)=0;
-      If Result then
-        begin
-          SetAddOpt(coa,S);
-          Exit;
-        end;
-      end;
-    end;
-  Verbose(V_ERROR,'Unknown option : '+n+S);
-end;
-
-Procedure ProcessConfigfile(FN : String);
-
-Var
-  F : Text;
-  S : String;
-  I : Integer;
-
-begin
-  // Set the default value for old digests without RelSrcDir to the rtl/compiler
-  // testsuite
-  RelSrcDir:='tests/';
-  If Not FileExists(FN) Then
-    Exit;
-  Verbose(V_DEBUG,'Parsing config file: '+FN);
-  Assign(F,FN);
-  {$i-}
-  Reset(F);
-  If IOResult<>0 then
-    Exit;
-  {$I+}
-  While not(EOF(F)) do
-    begin
-    ReadLn(F,S);
-    S:=trim(S);
-    I:=Pos('#',S);
-    If I<>0 then
-      S:=Copy(S,1,I-1);
-    If (S<>'') then
-      ProcessOption(S);
-    end;
-  Close(F);
-end;
-
-Procedure ProcessCommandLine;
-
-Var
-  I : Integer;
-  O : String;
-  c,co : TConfigOpt;
-  ShortOptFound, Found : Boolean;
-
-begin
-  I:=1;
-  While I<=ParamCount do
-    begin
-    O:=Paramstr(I);
-    ShortOptFound:=(Length(O)=2) and (O[1]='-');
-    If ShortOptFound then
-      For co:=low(TConfigOpt) to high(TConfigOpt) do
-        begin
-        Found:=(O[2]=ConfigOpts[co]);
-        If Found then
-          begin
-          c:=co;
-          Break;
-          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
-      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;
-
-function GetTestRunFieldID(const name : string; TestRunID : Integer) : Integer;
-begin
-  GetTestRunFieldID:=IDQuery(
-    format('SELECT %s FROM TESTRUN WHERE TU_ID=%d',[name,TestRunID]));
-end;
-function GetTestRunStringFieldID(const name : string; TestRunID : Integer) : String;
-begin
-  GetTestRunStringFieldID:=StringQuery(
-    format('SELECT %s FROM TESTRUN WHERE TU_ID=%d',[name,TestRunID]));
-end;
-
-
-function GetSubmitter(TestRunID:Integer) : String;
-begin
-  GetSubmitter:=GetTestRunStringFieldID('TU_SUBMITTER',TestRunID);
-end;
-
-function GetComment(TestRunID:Integer) : String;
-begin
-  GetComment:=GetTestRunStringFieldID('TU_COMMENT',TestRunID);
-end;
-
-function GetMachine(TestRunID:Integer) : String;
-begin
-  GetMachine:=GetTestRunStringFieldID('TU_MACHINE',TestRunID);
-end;
-
-function GetDate(TestRunID:Integer) : String;
-begin
-  GetDate:=GetTestRunStringFieldID('TU_DATE',TestRunID);
-end;
-
-
-function GetTestConfigId(TestRunID : Integer) : Integer;
-var
-  qry : 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,[
-                     GetTestRunFieldID('TU_CPU_FK',TestRunID),
-                     GetTestRunFieldID('TU_OS_FK',TestRunID),
-                     GetTestRunFieldID('TU_VERSION_FK',TestRunID),
-                     GetTestRunFieldID('TU_CATEGORY_FK',TestRunID),
-                     GetSubmitter(TestRunID),
-                     GetMachine(TestRunID),
-                     GetComment(TestRunID)]));
-  GetTestConfigID:=ConfigID;
-end;
-
-function UpdateTestConfigID(TestRunID : Integer) : boolean;
-var
-  qry : string;
-  firstRunID, lastRunID,PrevRunID : Integer;
-  RunCount : Integer;
-  res : TSQLQuery;
-  AddCount : boolean;
-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 OpenQuery(qry,res,false) then
-        FreeQueryResult(res)
-      else
-        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 OpenQuery(qry,res,false) then
-        FreeQueryResult(res)
-      else
-        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 OpenQuery(qry,res,false) then
-        FreeQueryResult(res)
-      else
-        Verbose(V_Warning,'Update of LastRunID failed');
-      AddTestHistoryEntry(TestRunID,PrevRunID);
-      AddCount:=true;
-    end
-  else
-    Verbose(V_Warning,'TestRunID is equal to last!');
-  qry:=format('SELECT TCONF_COUNT_RUNS FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
-  RunCount:=IDQuery(qry);
-  { Add one to run count }
-  if AddCount then
-    begin
-      Inc(RunCount);
-      qry:=format('UPDATE TESTCONFIG SET TCONF_COUNT_RUNS=%d WHERE TCONF_ID=%d',
-                  [RunCount,ConfigID]);
-      if OpenQuery(qry,res,false) then
-        FreeQueryResult(res)
-      else
-        Verbose(V_Warning,'Update of TU_COUNT_RUNS failed');
-    end;
-end;
-
-function InsertNewTestConfigId(TestRunID: Integer) : longint;
-var
-  qry : string;
-  TestDate : string;
-begin
-  TestDate:=GetDate(TestRunID);
-  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,
-                     GetTestRunFieldID('TU_CPU_FK',TestRunID),
-                     GetTestRunFieldID('TU_OS_FK',TestRunID),
-                     GetTestRunFieldID('TU_VERSION_FK',TestRunID),
-                     GetTestRunFieldID('TU_CATEGORY_FK',TestRunID),
-                     GetSubmitter(TestRunID),
-                     GetMachine(TestRunID),
-                     GetComment(TestRunID),
-                     TestDate,TestDate,TestDate]);
-  Result:=InsertQuery(qry);
-  AddTestHistoryEntry(TestRunID,0);
-end;
-
-Procedure InsertRunsIntoConfigAndHistory(var GlobalRes : TSQLQuery);
-
-var
-  i,fid,num_fields,row_count : Integer;
-  Row : Variant;
-  s : string;
-  runid,previd : Integer;
-begin
-  with GlobalRes do
-    begin
-      num_fields:=FieldCount;
-      First;
-      Last; { be sure to read all }
-      row_count:=RecordCount;
-      Writeln('Row count=',row_count);
-      First;
-      for i:=0 to row_count-1 do
-        begin
-          row:=FieldValues['TR_ID'];
-          runid:=StrToIntDef(Row,-1);
-          previd:=GetTestPreviousRunHistoryID(RunID);
-          if previd>=0 then
-            begin
-              Writeln(format('RunID=%d already handled prevID=%d',[runID,prevID]));
-              continue;
-            end
-          else
-            begin
-              if GetTestConfigId(runid)=-1 then
-                begin
-                   InsertNewTestConfigId(RunID);
-                end
-              else
-                UpdateTestConfigID(RunID);
-            end;
-          Next;
-        end;
-    end;
-end;
-
-Procedure GetAllTestRuns(var GlobalRes : TSQLQuery);
-var
-  qry : string;
-begin
-  qry:='SELECT * FROM TESTRUN ORDER BY TU_ID';
-  if OffsetString<>'' then
-    qry:=qry+' LIMIT 1000 OFFSET '+OffsetString;
-  if not OpenQuery(qry,GlobalRes,false) then
-    Verbose(V_Warning,'Failed to fetch testrun content');
-end;
-
-
-var
-  GlobalRes : TSQLQuery;
-
-begin
-  ProcessConfigFile('dbdigest.cfg');
-  ProcessCommandLine;
-  ConnectToDatabase(DatabaseName,HostName,UserName,Password,Port);
-  GetAllTestRuns(GlobalRes);
-  InsertRunsIntoConfigAndHistory(GlobalRes);
-end.

tests/utils/dbdigest.lpi

@@ -4,14 +4,23 @@
     <Version Value="12"/>
     <General>
       <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
+        <SaveJumpHistory Value="False"/>
+        <SaveFoldState Value="False"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <Title Value="FPC Digest Application"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
+    <CustomData Count="3">
+      <Item0 Name="OpenAPIBase"/>
+      <Item1 Name="OpenAPIConfig"/>
+      <Item2 Name="OpenAPIFile"/>
+    </CustomData>
     <BuildModes>
       <Item Name="Default" Default="True"/>
     </BuildModes>
@@ -31,6 +40,22 @@
         <Filename Value="digestanalyst.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="tsdb.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="tsstring.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="tstypes.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="tsutils.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -39,6 +64,7 @@
       <Filename Value="dbdigest"/>
     </Target>
     <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>

tests/utils/dbdigest.pp

@@ -26,7 +26,7 @@ uses
   {$ifdef unix}
   cthreads,
   {$endif}
-  types, classes, custapp, sysutils, inifiles, teststr, testu, tresults, dbtests, digestanalyst;
+  types, classes, custapp, sysutils, inifiles, tsstring, tsutils, tstypes, tsdb, digestanalyst;
 
 Type
 

tests/utils/digest.pp

@@ -17,7 +17,7 @@
 program digest;
 
 uses
-  teststr;
+  tsstring;
 
 
 const

tests/utils/digestanalyst.pas

@@ -5,7 +5,7 @@ unit digestanalyst;
 interface
 
 uses
-  Classes, SysUtils, teststr, testu, tresults, dbtests;
+  Classes, SysUtils, tsstring, tsutils, tstypes, tsdb;
 
 Type
   // Program configuration
@@ -37,7 +37,7 @@ Type
     // 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;
+    function GetIDs(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.
@@ -73,7 +73,7 @@ end;
 
 procedure TDBDigestAnalyzer.Verbose(aLevel: TVerboseLevel; const aMsg: string);
 begin
-  testu.Verbose(aLevel,FPrefix+aMsg);
+  tsutils.Verbose(aLevel,FPrefix+aMsg);
 end;
 
 function TDBDigestAnalyzer.CheckIDs(var aData : TTestRunData): Boolean;
@@ -103,13 +103,13 @@ begin
     LongLogFile.LoadFromFile(aData.longlogfile);
     UseLongLog:=LongLogFile.Count>0;
     end;
-  if not GetIDS(aConfig,aData) then
+  if not GetIDS(aData) then
     exit;
   ProcessFile(aData.logfile,aData);
   UpdateTestRun(aData);
 end;
 
-function TDBDigestAnalyzer.GetIDs(const aConfig : TDigestConfig; var aData : TTestRunData): Boolean;
+function TDBDigestAnalyzer.GetIDs(var aData : TTestRunData): Boolean;
 
 
 begin
@@ -169,30 +169,6 @@ begin
     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 = '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>';
 

tests/utils/dotest.pp

@@ -25,8 +25,9 @@ uses
 {$ifdef macos}
   macutils,
 {$endif}
-  teststr,
-  testu,
+  tsstring,
+  tsutils,
+  tstypes,
   redir,
   bench,
   classes;
@@ -146,10 +147,10 @@ begin
       if VerbosePrefix='' then
         VerbosePrefix:='#'+UniqueSuffix+'# ';
       su:=VerbosePrefix+s;
-      testu.Verbose(lvl,su);
+      tsutils.Verbose(lvl,su);
     end
   else
-    testu.Verbose(lvl,s);
+    tsutils.Verbose(lvl,s);
 end;
 
 function ToStr(l:longint):string;

tests/utils/drop_testsuite.sql

@@ -0,0 +1,19 @@
+drop table testrunhistory;
+drop table testpreviousresults;
+drop table testlastresults;
+drop table testresults;
+drop table testrun;
+drop table testplatform;
+drop table testcategory;
+drop table testcpu;
+drop table testos;
+drop table tests;
+drop table testversion;
+drop sequence seq_testcategory;
+drop sequence seq_testcpu;
+drop sequence seq_testos;
+drop sequence seq_testplatform;
+drop sequence seq_testresults;
+drop sequence seq_testrun;
+drop sequence seq_tests;
+drop sequence seq_testversion;

tests/utils/testsuite.sql

@@ -12,8 +12,8 @@ CREATE DATABASE testsuite
     template = 'template0'
     CONNECTION LIMIT = -1
     IS_TEMPLATE = False;
-    
-\c testsuite    
+
+\c testsuite
 
 CREATE SEQUENCE SEQ_TESTCATEGORY as INT start with 1;
 
@@ -77,7 +77,28 @@ CREATE TABLE TESTS (
   T_NOTE varchar(255) default NULL,
   T_DESCRIPTION text,
   T_SOURCE text,
-  T_OPTS varchar(255) default NULL,
+  T_OPTS varchar(255) default '',
+  T_DELOPTS varchar(255) default '',
+  T_SKIPCPU VARCHAR(64) default '',
+  T_SKIPEMU VARCHAR(64) default '',
+  T_NEEDTARGET VARCHAR(64) default '',  
+  T_SKIPTARGET VARCHAR(64) default '',  
+  T_MAXVERSION VARCHAR(16) default '',  
+  T_KNOWNRUNNOTE VARCHAR(127) default '',  
+  T_KNOWNCOMPILENOTE VARCHAR(127) default '',
+  T_RECOMPILEOPT VARCHAR(127) default '',
+  T_KNOWNCOMPILEERROR INT DEFAULT 0,
+  T_NEEDEDAFTER boolean default 'f',
+  T_ISKNOWNRUNERROR Boolean default 'f',
+  T_Timeout INT DEFAULT 0,
+  T_CATEGORY VARCHAR(127) default '',
+  T_FILES VARCHAR(127) default '',
+  T_CONFIGFILESRC VARCHAR(127) default '',
+  T_CONFIGFILEDST VARCHAR(127) default '',
+  T_WPOPARAS VARCHAR(127) default '',
+  T_WPOPASSES INT DEFAULT 0,
+  T_DELFILES VARCHAR(127) default '',
+  T_EXPECTMSGS VARCHAR(127) default '',
   constraint PK_TESTS PRIMARY KEY  (T_ID)
 );
 
@@ -92,10 +113,11 @@ CREATE TABLE TESTPLATFORM (
   TP_VERSION_FK INT NOT NULL,
   TP_CATEGORY_FK int NOT NULL,
   TP_CONFIG VARCHAR(255) NOT NULL,
+  TP_MACHINE VARCHAR(64) 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 UNIQUE INDEX UDX_TESTPLATFORM ON TESTPLATFORM(TP_CPU_FK,TP_OS_FK,TP_VERSION_FK,TP_CATEGORY_FK,TP_CONFIG,TP_MACHINE);
 CREATE INDEX IDX_TESTPLATFORMRELATIONS ON TESTPLATFORM(TP_CPU_FK,TP_OS_FK,TP_VERSION_FK,TP_CATEGORY_FK);
 
 CREATE SEQUENCE SEQ_TESTRUN as BIGINT start with 1;
@@ -104,7 +126,6 @@ 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),
@@ -165,6 +186,13 @@ CREATE TABLE TESTPREVIOUSRESULTS (
 
 CREATE UNIQUE INDEX UDX_TESTPREVIOUSRESULTS ON TESTPREVIOUSRESULTS(TPR_PLATFORM_FK,TPR_TEST_FK);
 
+CREATE TABLE TESTRUNHISTORY (
+  TH_ID_FK BIGINT,
+  TH_PREVIOUS_FK BIGINT,
+  CONSTRAINT PK_TESTRUNHISTORY PRIMARY KEY (TH_ID_FK)	
+);
+CREATE INDEX IDX_PREVIOUS ON TESTRUNHISTORY(TH_PREVIOUS_FK);
+
 -- Create relations
 
 ALTER TABLE testplatform ADD CONSTRAINT fk_plaform_os FOREIGN KEY (tp_os_fk) REFERENCES testos (to_id);

tests/utils/testsuite/Makefile

@@ -3188,3 +3188,5 @@ makefiles: fpc_makefiles
 ifneq ($(wildcard fpcmake.loc),)
 include fpcmake.loc
 endif
+testsuite$(SRCEXEEXT): testsuite.pp  tscgiapp.pp  tsconsts.pas  tsgraph.pas  tshistory.pas  tshtml.pas  tssql.pas
+	$(COMPILER) $<

tests/utils/testsuite/Makefile.fpc

@@ -18,3 +18,7 @@ programs=testsuite
 
 [default]
 fpcdir=../../..
+
+[rules]
+testsuite$(SRCEXEEXT): testsuite.pp  tscgiapp.pp  tsconsts.pas  tsgraph.pas  tshistory.pas  tshtml.pas  tssql.pas
+	$(COMPILER) $<

tests/utils/testsuite/testsuite.lpi

@@ -1,265 +1,91 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="12"/>
     <General>
       <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
         <LRSInOutputDirectory Value="False"/>
+        <SaveJumpHistory Value="False"/>
+        <SaveFoldState Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
-      <MainUnit Value="0"/>
+      <SessionStorage Value="InProjectDir"/>
       <Title Value="testsuite"/>
-      <ActiveWindowIndexAtStart Value="0"/>
     </General>
+    <CustomData Count="3">
+      <Item0 Name="OpenAPIBase"/>
+      <Item1 Name="OpenAPIConfig"/>
+      <Item2 Name="OpenAPIFile"/>
+    </CustomData>
     <BuildModes Count="1">
       <Item1 Name="default" Default="True"/>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
-        <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <FileNameStdIn Value="/home/michael/response.html"/>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+            <FileNameStdIn Value="/home/michael/response.html"/>
+          </local>
+          <environment>
+            <UserOverrides Count="2">
+              <Variable0 Name="REQUEST_METHOD" Value="GET"/>
+              <Variable1 Name="QUERY_STRING" Value="action=4&amp;testfileid=70000"/>
+            </UserOverrides>
+          </environment>
+        </Mode0>
+      </Modes>
     </RunParams>
-    <Units Count="12">
+    <Units Count="9">
       <Unit0>
         <Filename Value="testsuite.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testsuite"/>
-        <EditorIndex Value="0"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="29" Y="5"/>
-        <UsageCount Value="72"/>
-        <Loaded Value="True"/>
-        <LoadedDesigner Value="True"/>
       </Unit0>
       <Unit1>
-        <Filename Value="utests.pp"/>
+        <Filename Value="tshttp.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="utests"/>
-        <IsVisibleTab Value="True"/>
-        <EditorIndex Value="1"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1003"/>
-        <CursorPos X="59" Y="919"/>
-        <UsageCount Value="72"/>
-        <Loaded Value="True"/>
       </Unit1>
       <Unit2>
-        <Filename Value="../../../../../fixbranch/rtl/linux/syslinux.pp"/>
-        <UnitName Value="SysLinux"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="94"/>
-        <CursorPos X="6" Y="136"/>
-        <UsageCount Value="26"/>
-        <LoadedDesigner Value="True"/>
+        <Filename Value="../tsdb.pp"/>
+        <IsPartOfProject Value="True"/>
       </Unit2>
       <Unit3>
-        <Filename Value="../../../../../test.sql"/>
-        <TopLine Value="1"/>
-        <CursorPos X="1" Y="1"/>
-        <SyntaxHighlighter Value="None"/>
-        <UsageCount Value="6"/>
+        <Filename Value="../tsutils.pp"/>
+        <IsPartOfProject Value="True"/>
       </Unit3>
       <Unit4>
-        <Filename Value="../../../../../fixbranch/rtl/unix/linux.pp"/>
-        <UnitName Value="Linux"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="27" Y="23"/>
-        <UsageCount Value="23"/>
-        <LoadedDesigner Value="True"/>
+        <Filename Value="tshistory.pas"/>
+        <IsPartOfProject Value="True"/>
       </Unit4>
       <Unit5>
-        <Filename Value="../../../../../projects/lazarus/components/editbutton/editbtn.pas"/>
-        <UnitName Value="EditBtn"/>
-        <TopLine Value="248"/>
-        <CursorPos X="56" Y="251"/>
-        <UsageCount Value="6"/>
+        <Filename Value="tsconsts.pas"/>
+        <IsPartOfProject Value="True"/>
       </Unit5>
       <Unit6>
-        <Filename Value="../../../../../projects/lazarus/components/editbutton/demo/frmmain.pp"/>
-        <ComponentName Value="Form1"/>
-        <UnitName Value="frmmain"/>
-        <TopLine Value="1"/>
-        <CursorPos X="31" Y="8"/>
-        <UsageCount Value="18"/>
+        <Filename Value="tssql.pas"/>
+        <IsPartOfProject Value="True"/>
       </Unit6>
       <Unit7>
-        <Filename Value="dbwhtml.pp"/>
-        <UnitName Value="dbwhtml"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="384"/>
-        <CursorPos X="27" Y="393"/>
-        <UsageCount Value="23"/>
-        <LoadedDesigner Value="True"/>
+        <Filename Value="tsgraph.pas"/>
+        <IsPartOfProject Value="True"/>
       </Unit7>
       <Unit8>
-        <Filename Value="../tresults.pp"/>
+        <Filename Value="tshtml.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tresults"/>
-        <UsageCount Value="36"/>
       </Unit8>
-      <Unit9>
-        <Filename Value="../../../../build/tag_2_6_4/fpcsrc/packages/fcl-base/src/wformat.pp"/>
-        <UnitName Value="wformat"/>
-        <EditorIndex Value="4"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="17"/>
-        <CursorPos X="15" Y="35"/>
-        <UsageCount Value="18"/>
-        <Loaded Value="True"/>
-      </Unit9>
-      <Unit10>
-        <Filename Value="../../../../build/tag_2_6_4/fpcsrc/packages/fcl-web/src/base/webutil.pp"/>
-        <UnitName Value="webutil"/>
-        <EditorIndex Value="3"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="1" Y="1"/>
-        <UsageCount Value="17"/>
-        <Loaded Value="True"/>
-      </Unit10>
-      <Unit11>
-        <Filename Value="../../../../build/tag_2_6_4/fpcsrc/packages/fcl-web/src/base/cgiapp.pp"/>
-        <UnitName Value="cgiapp"/>
-        <EditorIndex Value="2"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="34"/>
-        <CursorPos X="1" Y="40"/>
-        <UsageCount Value="17"/>
-        <Loaded Value="True"/>
-      </Unit11>
     </Units>
-    <JumpHistory Count="30" HistoryIndex="29">
-      <Position1>
-        <Filename Value="utests.pp"/>
-        <Caret Line="574" Column="45" TopLine="549"/>
-      </Position1>
-      <Position2>
-        <Filename Value="utests.pp"/>
-        <Caret Line="946" Column="27" TopLine="930"/>
-      </Position2>
-      <Position3>
-        <Filename Value="utests.pp"/>
-        <Caret Line="1103" Column="40" TopLine="1077"/>
-      </Position3>
-      <Position4>
-        <Filename Value="utests.pp"/>
-        <Caret Line="1467" Column="37" TopLine="1442"/>
-      </Position4>
-      <Position5>
-        <Filename Value="utests.pp"/>
-        <Caret Line="1468" Column="71" TopLine="1443"/>
-      </Position5>
-      <Position6>
-        <Filename Value="utests.pp"/>
-        <Caret Line="1469" Column="48" TopLine="1444"/>
-      </Position6>
-      <Position7>
-        <Filename Value="utests.pp"/>
-        <Caret Line="2531" Column="53" TopLine="2531"/>
-      </Position7>
-      <Position8>
-        <Filename Value="utests.pp"/>
-        <Caret Line="2554" Column="17" TopLine="2525"/>
-      </Position8>
-      <Position9>
-        <Filename Value="utests.pp"/>
-        <Caret Line="2533" Column="17" TopLine="2519"/>
-      </Position9>
-      <Position10>
-        <Filename Value="utests.pp"/>
-        <Caret Line="2544" Column="18" TopLine="2540"/>
-      </Position10>
-      <Position11>
-        <Filename Value="utests.pp"/>
-        <Caret Line="121" Column="1" TopLine="121"/>
-      </Position11>
-      <Position12>
-        <Filename Value="utests.pp"/>
-        <Caret Line="326" Column="24" TopLine="301"/>
-      </Position12>
-      <Position13>
-        <Filename Value="utests.pp"/>
-        <Caret Line="67" Column="1" TopLine="61"/>
-      </Position13>
-      <Position14>
-        <Filename Value="utests.pp"/>
-        <Caret Line="846" Column="3" TopLine="842"/>
-      </Position14>
-      <Position15>
-        <Filename Value="utests.pp"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position15>
-      <Position16>
-        <Filename Value="utests.pp"/>
-        <Caret Line="2555" Column="11" TopLine="2530"/>
-      </Position16>
-      <Position17>
-        <Filename Value="utests.pp"/>
-        <Caret Line="2554" Column="10" TopLine="2530"/>
-      </Position17>
-      <Position18>
-        <Filename Value="utests.pp"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position18>
-      <Position19>
-        <Filename Value="utests.pp"/>
-        <Caret Line="420" Column="21" TopLine="412"/>
-      </Position19>
-      <Position20>
-        <Filename Value="utests.pp"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position20>
-      <Position21>
-        <Filename Value="utests.pp"/>
-        <Caret Line="2555" Column="41" TopLine="2532"/>
-      </Position21>
-      <Position22>
-        <Filename Value="utests.pp"/>
-        <Caret Line="2493" Column="3" TopLine="2478"/>
-      </Position22>
-      <Position23>
-        <Filename Value="utests.pp"/>
-        <Caret Line="2" Column="1" TopLine="1"/>
-      </Position23>
-      <Position24>
-        <Filename Value="utests.pp"/>
-        <Caret Line="2534" Column="11" TopLine="2527"/>
-      </Position24>
-      <Position25>
-        <Filename Value="utests.pp"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position25>
-      <Position26>
-        <Filename Value="utests.pp"/>
-        <Caret Line="304" Column="21" TopLine="300"/>
-      </Position26>
-      <Position27>
-        <Filename Value="utests.pp"/>
-        <Caret Line="676" Column="1" TopLine="661"/>
-      </Position27>
-      <Position28>
-        <Filename Value="utests.pp"/>
-        <Caret Line="912" Column="13" TopLine="904"/>
-      </Position28>
-      <Position29>
-        <Filename Value="utests.pp"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position29>
-      <Position30>
-        <Filename Value="utests.pp"/>
-        <Caret Line="919" Column="16" TopLine="889"/>
-      </Position30>
-    </JumpHistory>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
@@ -271,9 +97,15 @@
         <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
     <Other>
-      <CompilerPath Value="$(CompPath)"/>
+      <CompilerMessages>
+        <IgnoredMessages idx5043="True"/>
+      </CompilerMessages>
     </Other>
   </CompilerOptions>
-  <EditorMacros Count="0"/>
 </CONFIG>

tests/utils/testsuite/testsuite.pp

@@ -1,19 +1,31 @@
 {$mode objfpc}
 {$h+}
+{$define httpserver}
 program testsuite;
 
-uses utests, tresults;
+uses
+  sysutils, httproute, fpweb, tshttp, tsconsts, tshtml,
+  {$ifdef httpserver}
+  fphttpapp
+  {$else}
+  fpcgi
+  {$endif}
+  ;
+
 
-Var
-  App : TTestSuite;
 
 begin
-  App:=TTestSuite.Create(nil);
-  Try
-    App.Title:='Free Pascal Compiler Test Suite Results';
-    App.Initialize;
-    App.Run;
-  Finally
-    App.Free;
-  end;
+  if paramstr(0)<>'' then
+    TestsuiteCGIURL:=TestsuiteURLPrefix+'cgi-bin/'+extractfilename(paramstr(0))
+  else
+    TestsuiteCGIURL:=TestsuiteURLPrefix+'cgi-bin/'+TestsuiteBin;
+
+  HTTPRouter.RegisterRoute('*',rmAll,@HandleTestSuiteRequest,True);
+  Application.Initialize;
+  {$ifdef httpserver}
+  Application.Port:=9090;
+  {$else}
+  IsCGI:=True;
+  {$endif}
+  Application.Run;
 end.

tests/utils/testsuite/tscgiapp.pp

@@ -0,0 +1,1180 @@
+unit tscgiapp;
+
+{$mode objfpc}
+{$h+}
+{$WARN 5024 off : Parameter "$1" not used}
+
+interface
+
+uses
+   classes, httpdefs, fphttp, cgiapp, fpcgi, custcgi, inifiles, types,  sysutils,
+   sqldb, whtml, db, dbwhtml,
+   tsgraph, dbtests, tssql, tshistory, tresults, tsconsts, testu, tshtml;
+
+Type
+  { TTestSuite }
+
+  TTestSuite = Class(TCustomHTTPModule)
+  Private
+    FResponse: TResponse;
+    FTitle: String;
+    FVars: TQueryData;
+    FRunData : TTestRunData;
+    FCompareRunData :TTestRunData;
+    FPlatFormID : Integer;
+    FHTMLWriter : TTestSuiteHtmlWriter;
+    FSQL : TTestSQL;
+    FConstructSQL : TTestSuiteSQL;
+    FRunStats : TRunStats;
+    FInfo : TDBInfo;
+    FRequest : TRequest;
+    FContent : TStream;
+    procedure DoDetailURL(aRunID: Int64; aDate: TDateTime; out aURl: String);
+    Procedure GetOverviewRowAttr(Sender : TObject; Var BGColor : String;
+                                   Var Align : THTMLAlign; Var VAlign : THTMLValign;
+                                   Var CustomAttr : String) ;
+    Procedure GetRunRowAttr(Sender : TObject; Var BGColor : String;
+                            Var Align : THTMLAlign; Var VAlign : THTMLValign;
+                            Var CustomAttr : String) ;
+    function CreateTestSQL: TTestSQL;
+    function GetVersionControlURL: string;
+    procedure ShowAllHistoryData(aQuery: TSQLQuery);
+    procedure ShowLastLog(aRunID: Int64; aTestID, aPlatformID: Integer);
+    procedure ShowSourceFile;
+    procedure WriteTestInfo;
+  Public
+    constructor createnew(aOwner : TComponent; CreateMode: Integer); override;
+    destructor destroy; override;
+    procedure HandleRequest(ARequest: TRequest; AResponse: TResponse); override;
+    Function InitCGIVars : Integer;
+    Procedure DoRun; // override;
+    Procedure ShowRunResults;
+    Procedure ShowRunComparison;
+    Procedure ShowOneTest;
+    Procedure ShowHistory;
+    Function ConnectToDB : Boolean;
+    procedure DisconnectFromDB;
+    Procedure ShowRunOverview;
+    Procedure CreateRunPie;
+    Function  ShowRunData : Boolean;
+    Procedure LDump(Const St : String);
+    Procedure LDumpLn(Const St : String);
+    Property Title : String Read FTitle Write FTitle;
+    Property Request : TRequest Read FRequest;
+    Property Response : TResponse Read FResponse;
+  end;
+
+Procedure HandleTestSuiteRequest(aRequest : TRequest; aResponse : TResponse);
+
+implementation
+
+uses
+  wformat,
+  dateutils;
+
+Procedure HandleTestSuiteRequest(aRequest : TRequest; aResponse : TResponse);
+
+Var
+  Suite : TTestSuite;
+
+begin
+  Suite:=TTestSuite.CreateNew(Nil);
+  try
+    Suite.Title:='Free Pascal Compiler Test Suite Results';
+    Suite.HandleRequest(aRequest,aResponse);
+    aResponse.SendResponse;
+  finally
+    Suite.Free;
+  end;
+
+end;
+
+
+procedure TTestSuite.DoRun;
+
+var
+  lAction : integer;
+
+begin
+//  Terminate;
+  Try
+    ConnectToDB;
+    lAction:=InitCGIVars;
+    if (FVars.RunID>0) and not FSQL.GetRunData(FVars.RunID,FRunData) then
+      FRunData.RunID:=-1;
+    if (FVars.CompareRunID>0) and not FSQL.GetRunData(FVars.CompareRunID,FCompareRunData) then
+      FCompareRunData.RunID:=-1;
+    Case lAction of
+      faction_show_overview :
+        begin
+        FHTMLWriter.EmitOverviewForm(Title);
+        ShowRunOverview;
+        end;
+      faction_show_run_results :
+        if (FVars.CompareRunID<=0) then
+          ShowRunResults
+        else
+          ShowRunComparison;
+      faction_show_run_pie : CreateRunPie;
+      faction_show_one_test : ShowOneTest;
+      faction_show_history : ShowHistory;
+      faction_compare_with_previous :
+        begin
+          FVars.CompareRunID:=FVars.RunID;
+          FVars.RunID:=FVars.PreviousRunID;
+          ShowRunComparison;
+        end;
+      faction_compare_with_next :
+        begin
+          FVars.CompareRunID:=FVars.NextRunID;
+          ShowRunComparison;
+        end;
+      faction_compare2_with_previous :
+        begin
+          FVars.RunID:=FVars.Previous2RunID;
+          ShowRunComparison;
+        end;
+      faction_compare2_with_next :
+        begin
+          FVars.RunID:=FVars.CompareRunID;
+          FVars.CompareRunID:=FVars.Next2RunID;
+          ShowRunComparison;
+        end;
+      faction_compare_both_with_previous :
+        begin
+          FVars.RunID:=FVars.PreviousRunID;
+          FVars.CompareRunID:=FVars.Previous2RunID;
+          ShowRunComparison;
+        end;
+      faction_compare_both_with_next :
+        begin
+          FVars.RunID:=FVars.NextRunID;
+          FVars.CompareRunID:=FVars.Next2RunID;
+          ShowRunComparison;
+        end;
+      end;
+  finally
+    FHTMLWriter.EmitEnd;
+    DisConnectFromDB;
+  end;
+end;
+
+
+function TTestSuite.InitCGIVars: Integer;
+
+var
+  L : TStrings;
+begin
+  TestsuiteCGIURL:=Request.ScriptName;
+  DateSeparator:='/';
+  L:=TStringList.Create;
+  try
+    FVars.InitFromVars(FSQL,Request.QueryFields);
+  finally
+    L.Free;
+  end;
+  Result:=FVars.Action;
+  SDetailsURL := TestsuiteCGIURL + '?action=1&amp;run1id=%s';
+end;
+
+procedure TTestSuite.DoDetailURL(aRunID: Int64; aDate: TDateTime; out aURl: String);
+var
+  lDate : String;
+begin
+  if aDate=0 then
+    lDate:='never'
+  else
+    lDate:=DateToStr(aDate);
+  aURL:=Self.FHTMLWriter.FormatDetailURL(IntToStr(aRunID),lDate);
+end;
+
+function TTestSuite.CreateTestSQL : TTestSQL;
+
+var
+  aIni : TCustomIniFile;
+  lPort : Integer;
+  lHostName,lDatabaseName,lUserName,lPassword : String;
+
+begin
+  Result:=Nil;
+  aIni:=TMemIniFile.Create(DefaultDBConfigFileName);
+  try
+    With aIni do
+      begin
+      lHostName:=ReadString(SSection,KeyHost,'localhost');
+      lDatabaseName:=ReadString(SSection,KeyName,'testsuite');
+      lUserName:=ReadString(SSection,KeyUser,'');
+      lPassword:=ReadString(SSection,KeyPassword,'');
+      lPort:=ReadInteger(SSection,KeyPort,0);
+      end;
+  finally
+    aIni.Free;
+  end;
+  if (lHostName='') or (lDatabaseName='') or (lUserName='') or (lPassword='') then
+    exit;
+  Result:=TTestSQL.create(lDatabaseName,lHostName,lUserName,lPassword,lPort);
+end;
+
+constructor TTestSuite.createnew(aOwner: TComponent; CreateMode: Integer);
+
+begin
+  inherited createNew(aOwner,CreateMode);
+
+  FSQL:=CreateTestSQL;
+  FInfo:=TDBInfo.Create;
+  FVars:=TQueryData.Create;
+  FConstructSQL:=TTestSuiteSQL.create(FVars,FSQL,FInfo);
+  FContent:=TMemoryStream.Create;
+  FHtmlWriter:=TTestSuiteHTMLWriter.Create(FContent,FSQL,FVars);
+  OnVerbose:[email protected];
+end;
+
+destructor TTestSuite.destroy;
+begin
+  OnVerbose:=Nil;
+  FreeAndNil(FContent);
+  FreeAndNil(FConstructSQL);
+  FreeAndNil(FInfo);
+  FreeAndNil(FVars);
+  FreeAndNil(FSQL);
+  inherited destroy;
+end;
+
+procedure TTestSuite.HandleRequest(ARequest: TRequest; AResponse: TResponse{; var AHandled: Boolean});
+
+begin
+  FRequest:=aRequest;
+  FResponse:=aResponse;
+  try
+    DoRun;
+    aResponse.ContentStream:=FContent;
+  finally
+    FRequest:=Nil;
+    FResponse:=Nil;
+  end;
+end;
+
+function TTestSuite.ConnectToDB: Boolean;
+
+begin
+  Result:=False;
+  Result:=FSQL.ConnectToDatabase;
+  if not Result then
+    exit;
+  FInfo.AllCategoryID:=FSQL.GetCategoryID('All');
+  FInfo.AllOSID:=FSQL.GetOSID('All');
+  FInfo.AllCPUID:=FSQL.GetCPUID('All');
+  if FVars.OSID <= 0 then
+    FVars.OSID:=FInfo.AllOSID;
+  if FVars.CPUID<=0 then
+    FVars.CPUID:=FInfo.AllCPUID;
+end;
+
+
+procedure TTestSuite.LDump(const St: String);
+
+var
+  ShortS : ShortString;
+  i,p  : longint;
+begin
+  i:=length(St);
+  p:=1;
+  while (i>255) do 
+    begin
+      ShortS:=copy(St,p,255);
+      inc(p,255);
+      dec(i,255);
+      FHTMLWriter.Dump(ShortS);
+    end;
+  ShortS:=Copy(St,p,255);
+  FHTMLWriter.Dump(ShortS);
+end;
+
+
+procedure TTestSuite.LDumpLn(const St: String);
+begin
+  LDump(St);
+  LDump(LineFeed);
+end;
+
+
+procedure TTestSuite.DisconnectFromDB;
+
+begin
+  If Assigned(FSQL) then
+    begin
+    FSQL.DisconnectDatabase;
+    FreeAndNil(FSQL);
+    end;
+end;
+
+
+procedure TTestSuite.GetOverviewRowAttr(Sender: TObject; var BGColor: String;
+  var Align: THTMLAlign; var VAlign: THTMLValign; var CustomAttr: String);
+begin
+  If ((Sender as TTAbleProducer).CurrentRow mod 2=0) then
+    BGColor:='#EEEEEE'
+end;
+
+procedure TTestSuite.ShowRunOverview;
+
+var
+  Qry : String;
+  Q : TSQLQuery;
+  A : String;
+  lTable : TTableProducer;
+
+begin
+  A:=SDetailsURL;
+  If FVars.OnlyFailed then
+    A:=A+'&amp;failedonly=1';
+  If FVars.NoSkipped then
+    A:=A+'&amp;noskipped=1';
+  Qry:=FConstructSQL.GetRunOverviewSQL;
+  If FVars.Debug then
+    Writeln('Query : '+Qry);
+  lTable:=Nil;
+  Q:=FSQL.CreateQuery(Qry);
+  try
+    Q.Open;
+    lTable:=FHTMLWriter.CreateTableProducer(Q);
+    lTable.Border:=True;
+    lTable.OnGetRowAttributes:=@GetOverViewRowAttr;
+    lTable.CreateColumns(Nil);
+    With lTable.TableColumns do
+      begin
+      ColumnByName('ID').ActionURL:=A;
+      ColumnByName('Failed').OnGetCellContents:[email protected];
+      ColumnByName('rev').OnGetCellContents:[email protected];
+      ColumnByName('comprev').OnGetCellContents:[email protected];
+      ColumnByName('rtlrev').OnGetCellContents:[email protected];
+      ColumnByName('packrev').OnGetCellContents:[email protected];
+      ColumnByName('testsrev').OnGetCellContents:[email protected];
+      end;
+    lTable.CreateTable(FContent);
+    FHTMLWriter.DumpLn(Format('<p>Record count: %d</p>',[Q.RecordCount]));
+  finally
+    lTable.Free;
+    Q.Free;
+  end;
+end;
+
+function TTestSuite.ShowRunData: Boolean;
+
+  procedure EmitOneRow(RowTitle,FieldLeft,FieldRight : String; is_same : boolean);
+    var
+      FieldColor : string;
+    begin
+      if (FieldRight='') then
+        FieldColor:=''
+      else if is_same then
+        FieldColor:='style="color:green;"'
+      else
+        FieldColor:='style="color:red;"';
+      With FHTMLWriter do
+        begin
+          RowNext;
+          if FieldColor<>'' then
+            begin
+              TagStart('TD',FieldColor);
+            end
+          else 
+            CellStart;
+          LDumpLn(RowTitle);
+          if FieldColor<>'' then
+            begin
+              CellEnd;
+              TagStart('TD',FieldColor);
+            end
+          else 
+            CellNext;
+          LDumpLn(FieldLeft);
+          if FieldColor<>'' then
+            begin
+             CellEnd;
+             TagStart('TD',FieldColor);
+            end
+          else 
+            CellNext;
+          LDumpLn(FieldRight);
+          CellEnd;
+        end;
+    end;
+
+  procedure EmitOneRow(RowTitle,FieldLeft,FieldRight : String);
+    var
+      is_same : boolean;
+    begin
+      is_same:=(FieldLeft=FieldRight);
+      EmitOneRow(RowTitle,FieldLeft,FieldRight,is_same);
+    end;
+
+var
+  aData,aCompData : TTestRunData;
+  AddNewPar : Boolean;
+
+  procedure EmitRow(RowTitle,FieldName : String);
+    var
+      FieldLeft, FieldRight : String;
+    begin
+      FieldLeft:=aData.GetField(FieldName);
+      if aCompData.RunID>0 then
+        FieldRight:=aCompData.GetField(FieldName)
+      else
+        FieldRight:='';
+      EmitOneRow(RowTitle,FieldLeft,FieldRight);
+    end;
+
+  procedure MaybeEmitButton(const aVar,aValue : String; aCondition : boolean);
+
+  begin
+    if not aCondition then exit;
+    FHTMLWriter.EmitSubmitButton(aVar,aValue);
+    AddNewPar:=True;
+  end;
+
+  procedure CheckPar;
+  begin
+    if not AddNewPar then exit;
+    FHTMLWriter.ParagraphEnd;
+    FHTMLWriter.ParaGraphStart;
+  end;
+
+Var
+  isComp : Boolean;
+  FLeft,FRight : string;
+  Date1, Date2 : String;
+  lNextRunID,lNext2RunID : Int64;
+  lPreviousRunID,lPrevious2RunID : Int64;
+  same_date : boolean;
+  CompilerDate1, CompilerDate2 : string;
+
+begin
+  lNextRunID:=-1;
+  lNext2RunID:=-1;
+  lPreviousRunID:=-1;
+  lPrevious2RunID:=-1;
+
+  Result:=(FVars.RunID<>-1);
+  If not Result then
+    exit;
+  if Not FSQL.GetRunData(FVars.RunID,aData) then
+    exit;
+  isComp:=FVars.CompareRunID>0;
+  if isComp and Not FSQL.GetRunData(FVars.CompareRunID,aCompData) then
+    exit;
+  With FHTMLWriter do
+    begin
+    FormStart(TestsuiteCGIURL,'get');
+    TableStart(3,true);
+    RowStart;
+      CellStart;
+        DumpLn('Run ID:');
+      CellNext;
+        EmitInput('run1id',IntToStr(FVars.RunID));
+      CellNext;
+        EmitInput('run2id',IntToStr(FVars.CompareRunID));
+      CellEnd;
+
+    EmitRow('Operating system:','os');
+    EmitRow('Processor:','cpu');
+    EmitRow('Version:','VERSION');
+    if Not IsComp then
+      FRight:=''
+    else
+      begin
+        FRight:=aCompData.GetField('Failed')+
+                '/'+aCompData.GetField('Ok')+
+                '/'+aCompData.GetField('Total');
+      end;
+    EmitOneRow('Fails/OK/Total:',
+         aData.GetField('Failed')+
+         '/'+aData.GetField('Ok')+
+         '/'+aData.GetField('Total'),
+      FRight);
+    EmitRow('Version:','VERSION');
+    EmitRow('Full version:','COMPILERFULLVERSION');
+    EmitRow('Config:','CONFIG');
+    EmitRow('Machine:','TP_MACHINE');
+    if (FVars.CategoryID>0) then
+      EmitRow('Category:','TU_CATEGORY_FK');
+    If (FVars.CategoryID=1) then
+      begin
+        FLeft:=aData.GetField('rev');
+        FormatSVNData(FLeft);
+        if isComp then
+          begin
+            FRight:=aCompData.GetField('rev');
+            FormatSVNData(FRight);
+          end
+        else
+          FRight:='';
+        EmitOneRow('SVN revisions:',FLeft,FRight);
+      end;
+    EmitRow('Submitter:','SUBMITTER');
+    Date1 := aData.GetField('date');
+    if Not IsComp then
+      FRight:=''
+    else
+      begin
+      Date2 := aCompData.GetField('date');
+      FRight:=Date2;
+      end;
+    same_date:=(date1=Date2);
+    EmitOneRow('Date:',Date1,FRight,same_date);
+    CompilerDate1 := aData.GetField('compilerdate');
+    if Not IsComp then
+      FRight:=''
+    else
+      begin
+      CompilerDate2 := aCompData.GetField('compilerdate');
+      FRight:=CompilerDate2;
+      end;
+    same_date:=(CompilerDate1=CompilerDate2);
+    EmitOneRow('CompilerDate:',CompilerDate1,FRight,same_date);
+    lPreviousRunID:=FSQL.GetPreviousRunID(aData.RunID);
+    EmitHiddenVar('previousrunid',lPreviousRunID);
+    FLeft:=IntToStr(lPreviousRunID);
+    if IsComp then
+      begin
+        lPrevious2RunID:=FSQL.GetPreviousRunID(FVars.CompareRunID);
+        FRight:=IntToStr(lPrevious2RunID);
+        EmitHiddenVar('previous2runid',lPrevious2RunID);
+      end
+    else
+      FRight:='';
+    EmitOneRow('Previous run:',FLeft,FRight);
+    lNextRunID:=FSQL.GetNextRunID(FVars.RunID);
+    EmitHiddenVar('nextrunid',lNextRunID);
+    FLeft:=IntToStr(lNextRunID);
+    if IsComp then
+      begin
+        lNext2RunID:=FSQL.GetNextRunID(FVars.CompareRunID);
+        FRight:=IntToStr(lNext2RunID);
+        EmitHiddenVar('next2runid',lNext2RunID);
+      end;
+    EmitOneRow('Next run:',FLeft,FRight);
+    RowEnd;
+    TableEnd;
+    ParagraphStart;
+    if FVars.Debug then
+      EmitHiddenVar('DEBUGCGI', '1');
+    EmitCheckBox('noskipped','1',FVars.NoSkipped);
+    DumpLn(' Hide skipped tests');
+    ParagraphEnd;
+    ParagraphStart;
+    EmitCheckBox('failedonly','1',FVars.onlyFailed);
+    DumpLn(' Hide successful tests');
+    ParagraphEnd;
+    ParaGraphStart;
+    AddNewPar:=false;
+    MaybeEmitButton('action', 'Compare_to_previous', lPreviousRunID<>-1);
+    MaybeEmitButton('action', 'Compare_to_next', (lNextRunID<>-1) and (lNextRunID <> FVars.CompareRunID));
+    MaybeEmitButton('action', 'Compare_right_to_previous', (lPrevious2RunID<>-1) and (lPrevious2RunID <> FVars.RunID));
+    MaybeEmitButton('action', 'Compare_right_to_next',lNext2RunID<>-1);
+    CheckPar;
+    MaybeEmitButton('action', 'Compare_both_to_previous', (lPrevious2RunID<>-1) and (lPreviousRunId<>-1));
+    MaybeEmitButton('action', 'Compare_both_to_next', (lNext2RunID<>-1) and (lNextRunId<>-1));
+    CheckPar;
+    MaybeEmitButton('action','Show/Compare',True);
+    MaybeEmitButton('action','View_history',FVars.TestFileID<>-1);
+    EmitResetButton('','Reset form');
+    ParagraphEnd;
+    FormEnd;
+    { give warning if dates reversed }
+    if IsComp and (aData.Date > aCompData.Date) then
+      begin
+      ParagraphStart;
+      DumpLn('Warning: testruns are not compared in chronological order.');
+      ParagraphEnd;
+      end;
+    end;
+end;
+
+procedure TTestSuite.ShowRunResults;
+
+Var
+  S : String;
+  Qry : String;
+  Q : TSQLQuery;
+  FL : String;
+  lTable : TTableProducer;
+
+begin
+  Response.ContentType:='text/html';
+  //EmitContentType;
+  With FHTMLWriter do
+    begin
+    EmitDocType;
+    EmitTitle(Title+' : Search Results');
+    HeaderStart(1);
+    DumpLn('Test suite results for run '+IntToStr(FVars.RunID));
+    HeaderEnd(1);
+    HeaderStart(2);
+    DumpLn('Test run data : ');
+    HeaderEnd(2);
+    If not ShowRunData then
+      begin
+      DumpLn('No data for test run with ID: '+IntToStr(FVars.RunID));
+      Exit;
+      end;
+    HeaderStart(2);
+    DumpLn('Detailed test run results:');
+    FL:='';
+    If FVars.OnlyFailed or FVars.NoSkipped then
+      begin
+      FL:='';
+      If FVars.OnlyFailed then
+        FL:='successful';
+      if FVars.NoSkipped then
+        begin
+        If (FL<>'') then
+          FL:=FL+' and ';
+        FL:=FL+'skipped';
+        end;
+      DumpLn(' ('+FL+' tests are hidden)');
+      end;
+    HeaderEnd(2);
+    FPlatFormID:=FSQL.GetPlatformID(FVars.RunID);
+    S:=Format(SQLSelectTestResults,[FVars.RunID,FPlatformID]);
+    If FVars.OnlyFailed then
+      S:=S+' AND (not TR_OK)';
+    If FVars.NoSkipped then
+      S:=S+' AND (not TR_SKIP)';
+    S:=S+' ORDER BY TR_ID ';
+    Qry:=S;
+    If FVars.Debug then
+      begin
+      ParaGraphStart;
+      Dumpln('Query : '+Qry);
+      ParaGraphEnd;
+      end;
+    end;
+  Q:=FSQL.CreateQuery(Qry);
+  try
+    Q.PacketRecords:=-1;
+    Q.Open;
+    FHTMLWriter.DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
+    FL:='Id,Filename';
+    If Not FVars.NoSkipped then
+      FL:=FL+',Skipped';
+    If Not FVars.OnlyFailed then
+      FL:=FL+',OK';
+    FL:=FL+',Result';
+    lTable:=FHTMLWriter.CreateTableProducer(Q);
+    lTable.Border:=True;
+    lTable.CreateColumns(FL);
+    lTable.OnGetRowAttributes:=@GetRunRowAttr;
+    With lTable.TableColumns do
+      begin
+      ColumnByName('Id').OnGetCellContents:[email protected];
+      ColumnByName('Filename').OnGetCellContents:[email protected];
+      ColumnByName('Result').OnGetCellContents:[email protected];
+      end;
+    lTable.CreateTable(FContent); //Response);
+  finally
+    lTable.Free;
+    Q.Free;
+  end;
+  If Not (FRunStats.OKCount=0) and not (FVars.NoSkipped and FVars.OnlyFailed) then
+    FHTMLWriter.EmitPieImage(FRunStats.OKCount,FRunStats.FailedCount,FRunStats.SkipCount);
+end;
+
+procedure TTestSuite.ShowOneTest;
+
+Var
+  Qry : String;
+  Q : TSQLQuery;
+  Res : Boolean;
+  lTable : TTableProducer;
+
+begin
+  Response.ContentType:='text/html';
+//  EmitContentType;
+  With FHTMLWriter do
+    begin
+    EmitDocType;
+    EmitTitle(Title+' : File '+FVars.TestFileName+' Results');
+    HeaderStart(1);
+    DumpLn('Test suite results for test file '+FVars.TestFileName);
+    HeaderEnd(1);
+    HeaderStart(2);
+    DumpLn('Test run data : ');
+    HeaderEnd(2);
+    if FVars.RunID<>-1 then
+      Res:=ShowRunData
+    else
+      Res:=True;
+    If not Res then
+      begin
+      DumpLn(Format('No data for test file with ID: %s',[FVars.TestFileID]));
+      exit;
+      end;
+    WriteTestInfo;
+    Qry:=FConstructSQL.GetSimpleTestResultsSQL;
+    If FVars.Debug then
+    begin
+      ParaGraphStart;
+      Dumpln('Query : '+Qry);
+      ParaGraphEnd;
+    end;
+    FRunStats:=Default(TRunStats);
+    lTable:=nil;
+    Q:=FSQL.CreateQuery(Qry);
+    try
+      Q.Open;
+      lTable:=CreateTableProducer(Q);
+      lTable.Border:=True;
+      lTable.CreateColumns(Nil);
+      With lTable.TableColumns do
+        begin
+        Delete(ColumnByName('TR_TEST_FK').Index);
+        ColumnByName('RUN').OnGetCellContents:=@FormatTestRunOverview;
+        ColumnByName('TR_RESULT').OnGetCellContents:=@FormatTestResult;
+        end;
+      lTable.CreateTable(FContent); // Response);
+      ParaGraphStart;
+      DumpLn(Format('Record count: %d',[Q.RecordCount]));
+      ParaGraphEnd;
+    finally
+      lTable.Free;
+      Q.Free;
+    end;
+    if FVars.RunId<>-1 then
+      ShowLastLog(FVars.RunId,fvars.testfileid,FRunData.PlatformID);
+    if FVars.CompareRunId<>-1 then
+      ShowLastLog(FVars.CompareRunId,fvars.testfileid,FRunData.PlatformID);
+    if FVars.Debug then
+      DumpLn(Format('After Log. Run ID: %d, Testfile ID: %d',[fvars.RunID, fvars.testfileid]));
+    ShowSourceFile;
+    end;
+end;
+
+procedure TTestSuite.ShowLastLog(aRunID : Int64; aTestID,aPlatformID : Integer);
+var
+  LLog : String;
+begin
+  LLog:=FSQL.StringQuery(Format('select TR_LOG from TESTLASTRESULTS left join testresults on (TL_TESTRESULTS_FK=TR_ID) where (TR_TEST_FK=%d) and (TL_PLATFORM_FK=%d)',[aTestID,aPlatformID]));
+  With FHTMLWriter do
+    if LLog<>'' then
+      begin
+      HeaderStart(2);
+      DumpLn(Format('No log of %d:',[aRunId]));
+      HeaderEnd(2);
+      end
+    else
+      begin
+      HeaderStart(2);
+      DumpLn(Format('Log of %d:',[aRunID]));
+      HeaderEnd(2);
+      PreformatStart;
+      system.Write(LLog);
+      system.flush(output);
+      PreformatEnd;
+      end;
+end;
+
+procedure TTestSuite.WriteTestInfo;
+
+var
+  lTestInfo : TTestInfo;
+
+begin
+  With FHTMLWriter do
+    begin
+    HeaderStart(2);
+    DumpLn('Test file "'+FVars.TestFileName+'" information:');
+    HeaderEnd(2);
+    ParaGraphStart;
+    if (FVars.TestFileID<>-1) and FSQL.GetTestInfo(FVars.TestFileID,lTestInfo) then
+      DumpTestInfo(lTestInfo);
+    ParaGraphEnd;
+    HeaderStart(2);
+    DumpLn('Detailed test run results:');
+    HeaderEnd(2);
+    end;
+end;
+
+
+procedure TTestSuite.ShowHistory;
+
+Var
+  Res : Boolean;
+  Qry : String;
+  Q : TSQLQuery;
+  TS : TTestStatus;
+  lHistory : TTestHistoryInfo;
+  lOSMap,lCPUMap,lVersionMap : TIntegerDynArray;
+  lTable : TTableProducer;
+
+begin
+//  Res:=False;
+  Response.ContentType:='text/html';
+  // EmitContentType;
+  lTable:=nil;
+  Q:=Nil;
+  try
+    With FHTMLWriter do
+      begin
+      EmitDocType;
+      if FVars.TestFileName<>'' then
+        EmitTitle(Title+' : File '+FVars.TestFileName+' Results')
+      else
+        EmitTitle(Title+' : History overview');
+      if FVars.TestFileName<>'' then
+        begin
+          HeaderStart(1);
+          DumpLn('Test suite results for test file '+FVars.TestFileName);
+          HeaderEnd(1);
+          HeaderStart(2);
+          DumpLn('Test run data : ');
+          HeaderEnd(2);
+        end;
+      if FVars.RunID<>-1 then
+        Res:=ShowRunData
+      else
+        begin
+        EmitHistoryForm(Title);
+        Res:=(FVars.TestFileID<>-1);
+        if not Res then
+          begin
+          HeaderStart(2);
+          if Trim(FVars.TestFileName) <> '' then
+            DumpLn(Format('Error: No test files matching "%s" found.', [FVars.TestFileName]))
+          else
+            DumpLn('Error: Please specify a test file.');
+          HeaderEnd(2);
+          end;
+        end;
+      If not Res then
+        exit;
+      if (FVars.TestFileName<>'') then
+        WriteTestInfo;
+      ParaGraphStart;
+      If not FInfo.IsAllCPU(FVars.CPUID) then
+        lCPUMap:=FSQL.CreateMap(mtCPU);
+      If not FInfo.IsAllOS(FVars.OSID) then
+        lOSMap:=FSQL.CreateMap(mtOS);
+      if not FInfo.IsAllVersion(fVars.VersionID) then
+        lVersionMap:=FSQL.CreateMap(mtVersion);
+      lHistory:=TTestHistoryInfo.Create(FSQL,lOSMap,lCPUMap,lVersionMap);
+      lHistory.OnGetDetailURL:=@DoDetailURL;
+
+      Qry:=FConstructSQL.GetTestResultsSQL;
+      If FVars.Debug then
+      begin
+        Writeln(system.stdout,'Query : '+Qry);
+        system.Flush(system.stdout);
+      end;
+      FRunStats:=Default(TRunStats);
+      Q:=FSQL.CreateQuery(Qry);
+      Q.PacketRecords:=-1;
+      Q.Open;
+      lHistory.UpdateFromDataset(Q);
+      DumpLn(Format('<p>Total = %d </p>',[lHistory.total_count]));
+      if lHistory.Total_count > 0 then
+        DumpLn(Format('<p>OK=%d Percentage= %3.2f </p>',[lHistory.OK_count,lHistory.OK_count*100/lHistory.total_count]));
+      if lHistory.Skip_count > 0 then
+        DumpLn(Format('<p>Skipped=%d Percentage= %3.2f </p>',[lHistory.Skip_count,lHistory.Skip_count*100/lHistory.total_count]));
+      if lHistory.total_count>0 then
+        begin
+          TableStart(5,True);
+          RowStart;
+          CellStart;
+          DumpLn('Result type');
+          CellNext;
+          DumpLn('Cat.');
+          CellNext;
+          DumpLn('Count');
+          CellNext;
+          DumpLn('Percentage');
+          CellNext;
+          DumpLn('First date');
+          CellNext;
+          DumpLn('Last Date');
+          CellEnd;
+        end;
+        For TS:=FirstStatus to LastStatus do
+          if lHistory.Result_count[TS]>0 then
+            begin
+              lHistory.WriteCounts(FHTMLWriter,TS);
+              lHistory.WriteCPUHistory(FHTMLWriter,TS);
+              lHistory.WriteOSHistory(FHTMLWriter,TS);
+              lHIstory.WriteVersionHistory(FHTMLWriter,TS);
+            end;
+        if lHistory.total_count>0 then
+          begin
+            TableEnd;
+          end;
+      end; // FHTMLWriter;
+    If FVars.Debug or FVars.ListAll then
+      ShowAllHistoryData(Q);
+    ShowSourceFile;
+  Finally
+    lTable.Free;
+    Q.Free;
+  end;
+end;
+
+procedure TTestSuite.ShowAllHistoryData(aQuery: TSQLQuery);
+
+var
+  FL : String;
+  lTable : TTableProducer;
+begin
+  aQuery.First;
+  FL:='RUN,Date,OK,SKIP,Result';
+  if FVars.Submitter='' then
+    FL:=FL+',Submitter';
+  if FVars.Machine='' then
+    FL:=FL+',Machine';
+  if FVars.Config='' then
+    FL:=FL+',Config';
+  if (FVars.OSID=-1) or (FVars.OSID=FInfo.AllOSID) then
+    FL:=FL+',OS';
+  if (FVars.CPUID=-1) or (FVars.CPUID=FInfo.AllCPUID) then
+    FL:=FL+',CPU';
+  if (FVars.VersionID=-1) or (FVars.VersionID=FInfo.AllVersionID) then
+    FL:=FL+',Version';
+  FL:=FL+',Fails,CompDate';
+  FL:=FL+',Tests_rev,RTL_rev,Compiler_rev,Packages_rev';
+  lTable:=FHTMLWriter.CreateTableProducer(aQuery);
+  try
+    lTable.Border:=True;
+    lTable.CreateColumns(FL);
+    lTable.TableColumns.ColumnByName('RUN').OnGetCellContents:[email protected];
+    lTable.TableColumns.ColumnByName('Result').OnGetCellContents:[email protected];
+    lTable.CreateTable(FContent); //Response);
+  finally
+    lTable.Free
+  end;
+end;
+
+
+function TTestSuite.GetVersionControlURL : string;
+
+var
+  Base,lURL : String;
+  ver : known_versions;
+  Index : Integer;
+
+begin
+  Base:='trunk';
+  if  FVars.VersionBranch<>'' then
+    begin
+      // Test all but last version, which is assumed to be trunk
+      for ver:=low(known_versions) to pred(high(known_versions)) do
+        if ver_string[ver]=FVars.VersionBranch then
+          begin
+            base:=ver_branch[ver];
+            break;
+          end;
+    end;
+  index:=pos('/',Base);
+  if index>0 then
+    Base:=Copy(Base,index+1,length(Base));
+  if Base='trunk' then
+    Base:='main';
+  lURL:=ViewGitHashURL+Base;
+  if FVars.CategoryID=1 then
+    lURL:=lURL+TestsSubDir
+  else
+    begin
+    lURL:=lURL+DataBaseSubDir;
+    // This assumes that type TAnyType is
+    // defined in anytype.pas source PM
+    if pos('/',FVars.TestFileName)>0 then
+      FVars.Testfilename:=lowercase(copy(FVars.TestFilename,2,pos('/',FVars.TestFilename)-2)+'.pas');
+    end;
+  Result:=lURL;
+end;
+
+procedure TTestSuite.ShowSourceFile;
+
+var
+  lFN,lUrl,Source : String;
+
+begin
+  Source:='';
+  lFn:=FVars.TestFileName;
+  if (fvars.testfileid <> -1) then
+    Source:=FSQL.GetTestSource(fvars.testfileid);
+  With FHTMLWriter do
+    begin
+    if Source<>'' then
+      begin
+      HeaderStart(2);
+      DumpLn('Source:');
+      HeaderEnd(2);
+      PreformatStart;
+      Dumpln(Source);
+      PreformatEnd;
+      end;
+    if (Source='') then
+      DumpLn('<P>No Source in TestSuite DataBase.</P>');
+    lURL:=GetVersionControlURL;
+    HeaderStart(3);
+    DumpLn('Link to Git view of '+
+         '<A HREF="'+lURL+lFn+'?view=markup'+
+         '" TARGET="fpc_source"> '+lFN+'</A> source. ');
+    HeaderEnd(3);
+    end;
+end;
+
+procedure TTestSuite.ShowRunComparison;
+
+Var
+  Qry : String;
+  Q : TSQLQuery;
+  FL : String;
+  lTable : TTableProducer;
+
+begin
+  Response.ContentType:='text/html';
+//  EmitContentType;
+  With FHTMLWriter do
+    begin
+    EmitDocType;
+    EmitTitle(Title+' : Compare 2 runs');
+    HeaderStart(1);
+    DumpLn(Format('Test suite results for run %d vs. %d',[FVars.RunID,FVars.CompareRunID]));
+    HeaderEnd(1);
+    HeaderStart(2);
+    DumpLn('Test run data: ');
+    HeaderEnd(2);
+    If Not ShowRunData then
+      begin
+      DumpLn(Format('No data for test run with ID: %d',[FVars.RunID]));
+      exit;
+      end;
+    HeaderStart(2);
+    DumpLn('Detailed test run results:');
+    FL:='';
+    If FVars.OnlyFailed or FVars.NoSkipped then
+      begin
+      FL:='';
+      If FVars.OnlyFailed then
+        FL:='successful';
+      if FVars.NoSkipped then
+        begin
+        If (FL<>'') then
+          FL:=FL+' and ';
+        FL:=FL+'skipped';
+        end;
+      DumpLn(' ('+FL+' tests are hidden)');
+      end;
+    HeaderEnd(2);
+    ParaGraphStart;
+    end;
+  Qry:=FConstructSQL.GetCompareRunSQL;
+  If FVars.Debug then
+    begin
+    system.WriteLn('Query: '+Qry);
+    system.Flush(stdout);
+    end;
+  FRunStats:=Default(TRunStats);
+  Q:=FSQL.CreateQuery(Qry);
+  try
+    Q.Open;
+    FL:='Id,Filename,Run1_OK,Run2_OK';
+    If Not FVars.NoSkipped then
+      FL:=FL+',Run1_Skipped,Run2_Skipped';
+    FL:=FL+',Run1_Result,Run2_Result';
+    lTable:=FHTMLWriter.CreateTableProducer(Q);
+    lTable.Border:=True;
+    lTable.CreateColumns(FL);
+    lTable.OnGetRowAttributes:=@GetRunRowAttr;
+    With lTable.TableColumns do
+      begin
+      ColumnByName('Id').OnGetCellContents:[email protected];
+      ColumnByName('Run1_Result').OnGetCellContents:[email protected];
+      ColumnByName('Run2_Result').OnGetCellContents:[email protected];
+      ColumnByName('Filename').OnGetCellContents:[email protected];
+      end;
+    //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
+    lTable.CreateTable(FContent); // Response);
+    FHTMLWriter.DumpLn(format('<p>Record count: %d</P>',[Q.RecordCount]));
+  finally
+    lTable.Free;
+    Q.Free;
+  end;
+  If Not (FRunStats.OKCount=0) and not (FVars.NoSkipped and FVars.OnlyFailed) then
+    FHTMLWriter.EmitPieImage(FRunStats.OKCount,FRunStats.FailedCount,FRunStats.SkipCount);
+end;
+
+procedure TTestSuite.GetRunRowAttr(Sender: TObject; var BGColor: String;
+  var Align: THTMLAlign; var VAlign: THTMLValign; var CustomAttr: String);
+
+Var
+  P : TTableProducer;
+  Skip1Field, Skip2Field, Run1Field, Run2Field : TField;
+
+begin
+  P:=(Sender as TTableProducer);
+  Inc(FRunStats.OKCount);
+  If (FVars.OnlyFailed and FVars.NoSkipped) then
+    begin
+    If (P.CurrentRow Mod 2)=0 then
+      BGColor:='#EEEEEE'
+    end
+  else
+    begin
+    Skip1Field := P.Dataset.FindField('Skipped');
+    if Skip1Field = nil then
+      begin
+      Skip1Field := P.Dataset.FindField('Run1_Skipped');
+      Skip2Field := P.Dataset.FindField('Run2_Skipped');
+      end
+    else
+      Skip2Field := nil;
+    Run1Field := P.Dataset.FindField('OK');
+    if Run1Field = nil then
+      Run1Field := P.Dataset.FindField('Run1_OK');
+    Run2Field := P.Dataset.FindField('OK');
+    if Run2Field = nil then
+      Run2Field := P.Dataset.FindField('Run2_OK');
+    If (not FVars.NoSkipped) and ((Skip1Field.AsBoolean)
+        or ((Skip2Field <> nil) and (Skip2Field.AsBoolean))) then
+      begin
+      Inc(FRunStats.SkipCount);
+      BGColor:='yellow';    // Yellow
+      end
+    else If Run2Field.AsBoolean then
+      begin
+      if Run1Field.AsString='' then
+        BGColor:='#68DFB8'
+      else if Run1Field.AsBoolean then
+        BGColor:='#98FB98';    // pale Green
+      end
+    else if Not Run2Field.AsBoolean then
+      begin
+      Inc(FRunStats.FailedCount);
+      if Run1Field.AsString='' then
+        BGColor:='#FF82AB'    // Light red
+      else if Not Run1Field.AsBoolean then
+        BGColor:='#FF225B';
+      end;
+    end;
+end;
+
+procedure TTestSuite.CreateRunPie;
+
+Var
+  lGraph : TTestSuiteGraph;
+
+begin
+  lGraph:=TTestSuiteGraph.Create(FVars);
+  try
+    If FVars.RunCount=0 Then
+      Raise Exception.Create('Invalid parameters passed to script: No total count');
+    lGraph.DrawPie(FContent,FVars.RunSkipCount,FVars.RunFailedCount,FVars.RunCount);
+    Response.ContentType:='image/png';
+    FContent.Position:=0;
+  Finally
+    lGraph.Free;
+  end;
+end;
+
+begin
+  ShortDateFormat:='yyyy/mm/dd';
+end.

tests/utils/testsuite/tsconsts.pas

@@ -0,0 +1,181 @@
+unit tsconsts;
+
+{$mode ObjFPC}
+
+interface
+
+const
+  TestResultsTableName = 'TESTRESULTS';
+  MaxLimit = 1000;
+
+  TestsuiteURLPrefix='http://www.freepascal.org/testsuite/';
+  TestsuiteBin='testsuite.cgi';
+  ViewURL='http://svn.freepascal.org/cgi-bin/viewvc.cgi/';
+  ViewRevURL='http://svn.freepascal.org/cgi-bin/viewvc.cgi?view=revision&revision=';
+  ViewGitHashURL='https://gitlab.com/freepascal.org/fpc/source/-/tree/';
+  TestsSubDir='/tests/';
+  DataBaseSubDir='/packages/fcl-db/tests/';
+
+
+  faction_show_overview = 0;
+  faction_show_run_results = 1;
+  faction_show_run_pie = 2;
+  faction_show_one_test = 3;
+  faction_show_history = 4;
+  faction_compare_with_previous = 5;
+  faction_compare_with_next = 6;
+  faction_compare2_with_previous = 7;
+  faction_compare2_with_next = 8;
+  faction_compare_both_with_previous = 9;
+  faction_compare_both_with_next = 10;
+
+Var
+  SDetailsURL : string;
+
+type
+  known_versions = (
+    ver_unknown,
+    ver_1_0_10,
+    ver_2_0_0,
+    ver_2_0_1,
+    ver_2_0_2,
+    ver_2_0_3,
+    ver_2_0_4,
+    ver_2_0_5,
+    ver_2_1_2,
+    ver_2_1_4,
+    ver_2_2_0,
+    ver_2_2_1,
+    ver_2_2_2,
+    ver_2_2_3,
+    ver_2_2_4,
+    ver_2_2_5,
+    ver_2_3_1,
+    ver_2_4_0,
+    ver_2_4_1,
+    ver_2_4_2,
+    ver_2_4_3,
+    ver_2_4_4,
+    ver_2_4_5,
+    ver_2_5_1,
+    ver_2_6_0,
+    ver_2_6_1,
+    ver_2_6_2,
+    ver_2_6_3,
+    ver_2_6_4,
+    ver_2_6_5,
+    ver_2_7_1,
+    ver_3_0_0,
+    ver_3_0_1,
+    ver_3_0_2,
+    ver_3_0_3,
+    ver_3_0_4,
+    ver_3_0_5,
+    ver_3_1_1,
+    ver_3_2_0,
+    ver_3_2_1,
+    ver_3_2_2,
+    ver_3_2_3,
+    ver_3_3_1);
+
+
+const
+  ver_trunk = high (known_versions);
+  ver_string : array[known_versions] of string =
+  (
+   'unknown',
+   '1.0.10',
+   '2.0.0',
+   '2.0.1',
+   '2.0.2',
+   '2.0.3',
+   '2.0.4',
+   '2.0.5',
+   '2.1.2',
+   '2.1.4',
+   '2.2.0',
+   '2.2.1',
+   '2.2.2',
+   '2.2.3',
+   '2.2.4',
+   '2.2.5',
+   '2.3.1',
+   '2.4.0',
+   '2.4.1',
+   '2.4.2',
+   '2.4.3',
+   '2.4.4',
+   '2.4.5',
+   '2.5.1',
+   '2.6.0',
+   '2.6.1',
+   '2.6.2',
+   '2.6.3',
+   '2.6.4',
+   '2.6.5',
+   '2.7.1',
+   '3.0.0',
+   '3.0.1',
+   '3.0.2',
+   '3.0.3',
+   '3.0.4',
+   '3.0.5',
+   '3.1.1',
+   '3.2.0',
+   '3.2.1',
+   '3.2.2',
+   '3.2.3',
+   '3.3.1'
+  );
+
+  ver_branch : array [known_versions] of string =
+  (
+   '',
+   '',
+   'tags/release_2_0_0',
+   'branches/fixes_2_0',
+   'tags/release_2_0_2',
+   'branches/fixes_2_0',
+   'tags/release_2_0_4',
+   'branches/fixes_2_0',
+   'tags/release_2_1_2',
+   'tags/release_2_1_4',
+   'tags/release_2_2_0',
+   'branches/fixes_2_2',
+   'tags/release_2_2_2',
+   'branches/fixes_2_2',
+   'tags/release_2_2_4',
+   'branches/fixes_2_2',
+   'branches/fixes_2_2',
+   'tags/release_2_4_0',
+   'tags/release_2_4_0',
+   'tags/release_2_4_2',
+   'tags/release_2_4_2',
+   'tags/release_2_4_4',
+   'tags/release_2_4_4',
+   'branches/fixes_2_4',
+   'tags/release_2_6_0',
+   'tags/release_2_6_0',
+   'tags/release_2_6_2',
+   'tags/release_2_6_2',
+   'tags/release_2_6_4',
+   'tags/release_2_6_4',
+   'branches/fixes_2_6',
+   'tags/release_3_0_0',
+   'tags/release_3_0_0',
+   'tags/release_3_0_2',
+   'tags/release_3_0_2',
+   'tags/release_3_0_4',
+   'tags/release_3_0_4',
+   'branches/fixes_3_0',
+   'tags/release_3_2_0',
+   'tags/release_3_2_0',
+   'tags/release_3_2_2',
+   'branches/fixes_3_2',
+   'trunk'
+  );
+
+implementation
+
+end.
+

tests/utils/testsuite/tsgraph.pas

@@ -0,0 +1,183 @@
+unit tsgraph;
+
+{$mode ObjFPC}
+
+interface
+
+uses
+  Classes, SysUtils, tssql, ftFont,fpimage,fpimgcanv,fpWritePng,fpcanvas;
+
+Type
+
+  { TTestSuiteGraph }
+
+  TTestSuiteGraph = class(TObject)
+  Private
+    FVars : TQueryData;
+  Protected
+    procedure DoDrawPie(Img: TFPCustomImage; Skipped, Failed, Total: Integer);
+  Public
+    constructor create(aVars : TQueryData);
+    procedure DrawPie(aPNGImage: TStream; Skipped, Failed, Total: Integer);
+  end;
+
+implementation
+
+
+constructor TTestSuiteGraph.create(aVars: TQueryData);
+begin
+  fVars:=aVars;
+  ftFont.InitEngine;
+  FontMgr.SearchPath:='/usr/share/fonts/truetype/liberation/';
+end;
+
+procedure TTestSuiteGraph.DrawPie(aPNGImage: TStream; Skipped, Failed, Total: Integer);
+
+var
+  lImg : TFPMemoryImage;
+  lWriter: TFPWriterPNG;
+
+begin
+  lWriter:=Nil;
+  lImg:=TFPMemoryImage.Create(320,320);
+  try
+    DoDrawPie(lImg,Skipped,Failed,Total);
+    lWriter:=TFPWriterPNG.Create;
+    lWriter.UseAlpha:=True;
+    lWriter.ImageWrite(aPNGImage,lImg);
+    aPNGImage.Position:=0;
+  finally
+    lWriter.Free;
+    lImg.Free;
+  end;
+end;
+
+procedure TTestSuiteGraph.DoDrawPie(Img: TFPCustomImage; Skipped, Failed, Total: Integer);
+
+Var
+  Cnv : TFPImageCanvas;
+
+  Procedure AddPie(X,Y,R : Integer; AStart,AStop : Double; Col : TFPColor);
+
+  Var
+    DX,Dy : Integer;
+
+  begin
+    DX:=Round(R*Cos(AStart));
+    DY:=Round(R*Sin(AStart));
+    Cnv.Line(X,Y,X+DX,Y-DY);
+    DX:=Round(R*Cos(AStop));
+    DY:=Round(R*Sin(AStop));
+    Cnv.Line(X,Y,X+DX,Y-Dy);
+    DX:=Round(R/2*Cos((AStart+AStop)/2));
+    DY:=Round(R/2*Sin((AStart+AStop)/2));
+    Cnv.Brush.FpColor:=Col;
+    Cnv.FloodFill(X+DX,Y-DY);
+  end;
+
+  Function FractionAngle(F,T : Integer): Double;
+
+  begin
+    Result:=(2*Pi*(F/T))
+  end;
+
+Var
+  W,H,FH,CR,RA : Integer;
+  A1,A2,FR,SR,PR : Double;
+  R : TRect;
+  F : TFreeTypeFont;
+
+begin
+  F:=TFreeTypeFont.Create;
+  With F do
+    begin
+    Name:='LiberationSans-Regular.ttf';
+    FontIndex:=0;
+    Size:=12;
+    FPColor:=colred;
+    AntiAliased:=False;
+    Resolution:=96;
+    end;
+  if FVars.Debug then
+    Writeln(stdout,'Creating image');
+  Cnv:=TFPImageCanvas.Create(Img);
+  if FVars.Debug then
+    Writeln(stdout,'CNV=0x',hexstr(ptruint(cnv),16));
+
+  if FVars.Debug then
+   Writeln(stdout,'Getting width and height');
+  W:=Img.Width;
+  H:=Img.Height;
+  if FVars.Debug then
+    begin
+      Writeln(stdout,'width=',W,' height=',H);
+      //system.flush(stdout);
+    end;
+  // Writeln('Transparant');
+  cnv.Brush.Style:=bsSolid;
+  cnv.Brush.FPColor:=colTransparent;
+  cnv.Pen.FPColor:=colWhite;
+  Cnv.Rectangle(0,0,W,H);
+  if FVars.DEbug then
+    Writeln(stdout,'Setting font');
+  Cnv.Font:=F;
+  if FVars.Debug then
+    Writeln(stdout,'Getting textwidth ');
+  FH:=CNV.GetTextHeight('A');
+  If FH=0 then
+    FH:=14; // 3 * 14;
+  if FVars.Debug then
+    writeln(stdout,'FH=',FH);
+  Inc(FH,3);
+  R.Top:=FH*4;
+  R.Left:=0;
+  R.Bottom:=H;
+  CR:=H-(FH*4);
+  If W>CR then
+    R.Right:=CR
+  else
+    R.Right:=W;
+  Ra:=CR div 2;
+  if FVars.DEbug then
+    begin
+      Writeln(stdout,'Setting pen color');
+      system.flush(stdout);
+    end;
+  Cnv.Pen.FPColor:=colBlack;
+  if FVars.Debug then
+    begin
+      Writeln(stdout,'Palette size : ',Img.Palette.Count);
+      Writeln(stdout,'Setting brush style');
+      system.flush(stdout);
+    end;
+  cnv.brush.FPColor:=colDkGray;
+  SR:=Skipped/Total;
+  FR:=Failed/Total;
+  PR:=1-SR-FR;
+  cnv.font.FPColor:=colDkGray;
+  Cnv.Textout(1,FH*2,Format('%d Skipped (%3.1f%%)',[Skipped,SR*100]));
+//  cnv.pen.width:=1;
+  // Writeln('Drawing ellipse');
+  Cnv.Ellipse(R);
+  if FVars.Debug then
+    begin
+      Writeln(stdout,'Setting text');
+      system.flush(stdout);
+    end;
+  A1:=0;
+  A2:=A1+FractionAngle(Failed,Total);
+  cnv.font.FPColor:=colRed;
+  Cnv.Textout(1,FH*3,Format('%d Failed (%3.1f%%)',[Failed,FR*100]));
+  AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColRed);
+  cnv.font.FPColor:=colGreen;
+  Cnv.Textout(1,FH,Format('%d Passed (%3.1f%%)',[Total-Skipped-Failed,PR*100]));
+  // Writeln('Palette size : ',Img.Palette.Count);
+  A1:=A2;
+  A2:=A1+FractionAngle(Total-(Skipped+Failed),Total);
+  AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColGreen);
+  // Writeln('Palette size : ',Img.Palette.Count);
+  // Writeln('All done');
+end;
+
+end.
+

tests/utils/testsuite/tshistory.pas

@@ -0,0 +1,465 @@
+unit tshistory;
+
+{$mode ObjFPC}
+{$h+}
+
+interface
+
+uses
+  Classes, SysUtils, types, tstypes, db, tsdb, whtml;
+
+Type
+
+  { TDatasetMap }
+
+  TDatasetMap = class(TObject)
+    OK,
+    Skip,
+    Result,
+    CPU,
+    OS,
+    Version,
+    Date,
+    Run : TField;
+    constructor Create(aDataset : TDataset);
+  end;
+
+  TGetDetailURLEvent = procedure (aRunID : Int64; aDate : TDateTime; out aURl : String) of object;
+
+
+  { TTestHistoryInfo }
+
+  TTestHistoryInfo = Class (TObject)
+  Const
+    { We already have 53 versions }
+    MaxCombo = 100;
+  Type
+    StatusLongintArray = Array [TTestStatus] of Int64;
+    StatusDateTimeArray = Array [TTestStatus] of TDateTime;
+    TStatusLAArray = Array of StatusLongintArray;
+    TStatusDTAArray = Array of StatusDateTimeArray;
+  private
+    function FormatDetailURL(aRunID: Int64; aDate: TDateTime): string;
+    procedure HandleCPU(aRunID: Int64; aCPUID: Integer; aStatus: TTestStatus; aDate: TDateTime);
+    procedure HandleDates(aRunID: Int64; aStatus: TTestStatus; aMap: TDatasetMap);
+    procedure HandleOS(aRunID: Int64; aOSID: Integer; aStatus: TTestStatus; aDate: TDateTime);
+    procedure HandleVersion(aRunID: Int64; aVersionID: Integer; aStatus: TTestStatus; aDate: TDateTime);
+    function MapCpu(aID: Integer): integer;
+    function MapOS(aID: Integer): integer;
+    function MapVersion(aID: Integer): integer;
+  Public
+    total_count:Integer;
+    OK_count:Integer;
+    not_OK_count:Integer;
+    skip_count:Integer;
+    not_skip_count:Integer;
+    os_count,cpu_count,version_count: TStatusLAArray;
+    os_first_date, os_last_date,
+    cpu_first_date, cpu_last_date,
+    version_first_date, version_last_date : TStatusDTAArray;
+    os_first_date_id, os_last_date_id,
+    cpu_first_date_id, cpu_last_date_id,
+    version_first_date_id, version_last_date_id : TStatusLAArray;
+    first_date, last_date : array[TTestStatus] of TDateTime;
+    first_date_id, last_date_id : array[TTestStatus] of Int64;
+    result_count : StatusLongintArray;
+    FCPUMap,FOSMap,FVersionMap :TIntegerDynArray;
+    FSQL : TTestSQL;
+    OnGetDetailURL : TGetDetailURLEvent;
+    constructor create(aSQL : TTestSQL; aOSMap,aCPUMap,aVersionMap : TIntegerDynArray);
+    procedure InitCPU(aCPUCount : Integer);
+    procedure InitVersion(aVersionCount : Integer);
+    procedure InitOS(aOSCount : Integer);
+    procedure UpdateFromDataset(Q: TDataset);
+    procedure WriteCounts(aHTMLWriter: THTMLWriter; TS: TTestStatus);
+    procedure WriteCPUHistory(aHTMLWriter: THTMLWriter; TS: TTestStatus);
+    procedure WriteOSHistory(aHTMLWriter: THTMLWriter; TS: TTestStatus);
+    procedure WriteVersionHistory(aHTMLWriter: THTMLWriter; TS: TTestStatus);
+
+
+  end;
+
+implementation
+
+{ TDatasetMap }
+
+constructor TDatasetMap.Create(aDataset: TDataset);
+
+begin
+  OK:=aDataset.FieldByName('OK');
+  Skip:=aDataset.FieldByName('SKIP');
+  Result:=aDataset.FieldByName('Result');
+  CPU:=aDataset.FieldByName('TC_ID');
+  OS:=aDataset.FieldByName('TO_ID');
+  Version:=aDataset.FieldByName('TV_ID');
+  Date:=aDataset.FieldByName('Date');
+  Run:=aDataset.FieldByName('TU_ID');
+end;
+
+{ TTestHistoryInfo }
+
+constructor TTestHistoryInfo.create(aSQL: TTestSQL; aOSMap, aCPUMap, aVersionMap: TIntegerDynArray);
+begin
+  FSQL:=aSQL;
+  FCPUMap:=aCPUMap;
+  FOSMap:=aOSMap;
+  FVersionMap:=aVersionMap;
+  InitCPU(Length(aCPUMap));
+  InitVersion(Length(aVersionMap));
+  InitOS(Length(aOSMap));
+end;
+
+procedure TTestHistoryInfo.InitCPU(aCPUCount: Integer);
+
+begin
+  SetLength(cpu_count,aCPUCount+1);
+  SetLength(cpu_first_date_id,aCPUCount+1);
+  SetLength(cpu_last_date_id,aCPUCount+1);
+  SetLength(cpu_first_date,aCPUCount+1);
+  SetLength(cpu_last_date,aCPUCount+1);
+end;
+
+procedure TTestHistoryInfo.InitVersion(aVersionCount: Integer);
+begin
+  SetLength(version_count,aVersionCount+1);
+  SetLength(version_first_date_id,aVersionCount+1);
+  SetLength(version_last_date_id,aVersionCount+1);
+  SetLength(version_first_date,aVersionCount+1);
+  SetLength(version_last_date,aVersionCount+1);
+end;
+
+procedure TTestHistoryInfo.InitOS(aOSCount: Integer);
+begin
+  SetLength(os_count,aOSCount+1);
+  SetLength(os_first_date_id,aOSCount+1);
+  SetLength(os_last_date_id,aOSCount+1);
+  SetLength(os_first_date,aOSCount+1);
+  SetLength(os_last_date,aOSCount+1);
+end;
+
+function TTestHistoryInfo.MapCpu(aID : Integer) : integer;
+
+begin
+  Result:=Length(FCPUMap)-1;
+  While (Result>=0) and (FCPUMap[Result]<>aID) do
+    dec(Result);
+end;
+
+function TTestHistoryInfo.MapOS(aID : Integer) : integer;
+
+begin
+  Result:=Length(FOSMap)-1;
+  While (Result>=0) and (FOSMap[Result]<>aID) do
+    dec(Result);
+end;
+
+function TTestHistoryInfo.MapVersion(aID: Integer): integer;
+begin
+  Result:=Length(FVersionMap)-1;
+  While (Result>=0) and (FVersionMap[Result]<>aID) do
+    dec(Result);
+end;
+
+
+procedure TTestHistoryInfo.HandleCPU(aRunID : Int64; aCPUID : Integer; aStatus : TTestStatus; aDate : TDateTime);
+
+var
+  lCPU : Integer;
+
+begin
+  if length(cpu_count)=0 then
+    exit;
+  lCPU:=MapCPU(aCPUID);
+  if lCPU=-1 then
+    exit;
+
+  if cpu_count[lCPU,aStatus]=0 then
+    begin
+      cpu_first_date[lCPU,aStatus]:=aDate;
+      cpu_last_date[lCPU,aStatus]:=aDate;
+      cpu_first_date_id[lCPU,aStatus]:=aRunID;
+      cpu_last_date_id[lCPU,aStatus]:=aRunID;
+    end
+  else
+    begin
+      if (aDate>cpu_last_date[lCPU,aStatus]) then
+        begin
+          cpu_last_date[lCPU,aStatus]:=aDate;
+          cpu_last_date_id[lCPU,aStatus]:=aRunID;
+        end;
+      if aDate<cpu_first_date[lCPU,aStatus] then
+        begin
+          cpu_first_date[lCPU,aStatus]:=aDate;
+          cpu_first_date_id[lCPU,aStatus]:=aRunID;
+        end;
+    end;
+  inc(cpu_count[lCPU,aStatus]);
+end;
+
+procedure TTestHistoryInfo.HandleOS(aRunID : Int64; aOSID : Integer; aStatus : TTestStatus; aDate : TDateTime);
+
+var
+  lOS : Integer;
+
+begin
+  if length(os_count)=0 then
+    exit;
+  lOS:=MapOS(aOSId);
+  if lOS=-1 then
+    exit;
+
+  if os_count[lOS,aStatus]=0 then
+    begin
+      os_first_date[lOS,aStatus]:=aDate;
+      os_last_date[lOS,aStatus]:=aDate;
+      os_first_date_id[lOS,aStatus]:=aRunID;
+      os_last_date_id[lOS,aStatus]:=aRunID;
+    end
+  else
+    begin
+      if (aDate>os_last_date[lOS,aStatus]) then
+        begin
+          os_last_date[lOS,aStatus]:=aDate;
+          os_last_date_id[lOS,aStatus]:=aRunID;
+        end;
+      if aDate<os_first_date[lOS,aStatus] then
+        begin
+          os_first_date[lOS,aStatus]:=aDate;
+          os_first_date_id[lOS,aStatus]:=aRunID;
+        end;
+    end;
+  inc(os_count[lOS,aStatus]);
+end;
+
+
+procedure TTestHistoryInfo.HandleDates(aRunID : Int64; aStatus : TTestStatus; aMap : TDatasetMap);
+
+var
+  lDate : TDateTime;
+
+begin
+  lDate:=aMap.Date.AsDateTime;
+  if Result_count[aStatus]=0 then
+    begin
+      first_date[aStatus]:=lDate;
+      last_date[aStatus]:=lDate;
+      first_date_id[aStatus]:=aRunID;
+      last_date_id[aStatus]:=aRunID;
+    end
+  else
+    begin
+      if (date>last_date[aStatus]) then
+        begin
+          last_date[aStatus]:=lDate;
+          last_date_id[aStatus]:=aRunID;
+        end;
+      if date<first_date[aStatus] then
+        begin
+          first_date[aStatus]:=lDate;
+          first_date_id[aStatus]:=aRunID;
+        end;
+    end;
+end;
+
+procedure TTestHistoryInfo.HandleVersion(aRunID : Int64; aVersionID : Integer; aStatus : TTestStatus; aDate : TDateTime);
+
+var
+  lVersion : Integer;
+
+begin
+  if length(version_count)=0 then
+    exit;
+  lVersion:=MapVersion(aVersionId);
+  if lVersion=-1 then
+    exit;
+
+  if version_count[lVersion,aStatus]=0 then
+    begin
+      version_first_date[lVersion,aStatus]:=aDate;
+      version_last_date[lVersion,aStatus]:=aDate;
+      version_first_date_id[lVersion,aStatus]:=aRunID;
+      version_last_date_id[lVersion,aStatus]:=aRunID;
+    end
+  else
+    begin
+      if (aDate>version_last_date[lVersion,aStatus]) then
+        begin
+          version_last_date[lVersion,aStatus]:=aDate;
+          version_last_date_id[lVersion,aStatus]:=aRunID;
+        end;
+      if aDate<version_first_date[lVersion,aStatus] then
+        begin
+          version_first_date[lVersion,aStatus]:=aDate;
+          version_first_date_id[lVersion,aStatus]:=aRunID;
+        end;
+    end;
+  inc(version_count[lVersion,aStatus]);
+
+end;
+
+procedure TTestHistoryInfo.UpdateFromDataset(Q: TDataset);
+
+var
+  lMap : TDatasetMap;
+  resi : Integer;
+  TS : TTestStatus;
+  lRunID: int64;
+  lDate : TDateTime;
+
+begin
+  lMap:=TDatasetMap.Create(Q);
+  While not Q.EOF do
+    begin
+    inc(total_count);
+    if lMap.OK.AsBoolean then
+      inc(OK_count)
+    else
+      inc(not_OK_count);
+    if lMap.Skip.AsBoolean then
+      inc(skip_count)
+    else
+      inc(not_skip_count);
+    lRunID:=lMap.Run.AsLongint;
+    resi:=lMap.Result.AsInteger;
+    if (Resi>=longint(FirstStatus)) and  (Resi<=longint(LastStatus)) then
+      begin
+        TS:=TTestStatus(Resi);
+        inc(Result_count[TS]);
+        HandleDates(lRunID,ts,lMap);
+        lDate:=lMap.Date.AsDateTime;
+        HandleCPU(lRunID,lMap.CPU.asInteger,ts,lDate);
+        HandleOS(lRunID,lMap.OS.AsInteger,ts,lDate);
+        HandleVersion(lRunID,lMap.Version.AsInteger,ts,lDate);
+      end;
+    Q.Next;
+    end;
+end;
+
+procedure TTestHistoryInfo.WriteCounts(aHTMLWriter: THTMLWriter; TS: TTestStatus);
+begin
+  With aHTMLWriter do
+    begin
+    RowNext;
+    CellStart;
+    DumpLn(StatusText[TS]);
+    CellNext;
+    CellNext;
+    DumpLn(Format('%d',[Result_count[TS]]));
+    CellNext;
+    DumpLn(Format('%3.1f',[Result_count[TS]*100/total_count]));
+    CellNext;
+
+    DumpLn(FormatDetailURL(first_date_id[TS], first_date[TS]));
+    DumpLn(' : '+IntToStr(FSQL.GetFailCount(first_date_id[TS])));
+    CellNext;
+    DumpLn(FormatDetailURL(last_date_id[TS], last_date[TS]));
+    DumpLn(' : '+IntToStr(FSQL.GetFailCount(last_date_id[TS])));
+    CellEnd;
+    end;
+end;
+
+function TTestHistoryInfo.FormatDetailURL(aRunID: Int64; aDate : TDateTime) : string;
+
+begin
+  if assigned(OnGetDetailURL) then
+    OnGetDetailURL(aRunID,aDate,Result)
+  else
+    Result:='';
+end;
+
+procedure TTestHistoryInfo.WriteCPUHistory(aHTMLWriter : THTMLWriter; TS : TTestStatus);
+
+var
+  i : Integer;
+
+begin
+  if not assigned(cpu_count) then
+    exit;
+
+  for i:=0 to Length(cpu_count)-1 do
+    if cpu_count[i,TS]>0 then
+      With aHTMLWriter do
+        begin
+        RowNext;
+        CellStart;
+        CellNext;
+        DumpLn(FSQL.GetCPUName(FCPUMap[i]));
+        CellNext;
+        DumpLn(Format('%d',[cpu_count[i,TS]]));
+        CellNext;
+        DumpLn(Format('%3.1f',[cpu_count[i,TS]*100/result_count[TS]]));
+        CellNext;
+        DumpLn(FormatDetailURL(cpu_first_date_id[i,TS], cpu_first_date[i,TS]));
+        DumpLn(' '+IntToStr(FSQL.GetFailCount(cpu_first_date_id[i,TS])));
+        CellNext;
+        DumpLn(FormatDetailURL(cpu_last_date_id[i,TS], cpu_last_date[i,TS]));
+        DumpLn(' '+IntToStr(FSQL.GetFailCount(cpu_last_date_id[i,TS])));
+        CellEnd;
+        end;
+end;
+
+procedure TTestHistoryInfo.WriteOSHistory(aHTMLWriter: THTMLWriter; TS: TTestStatus);
+
+var
+  i : Integer;
+
+begin
+  if not assigned(os_count) then
+    exit;
+
+  for i:=0 to Length(os_count)-1 do
+    if os_count[i,TS]>0 then
+      With aHTMLWriter do
+        begin
+        RowNext;
+        CellStart;
+        CellNext;
+        DumpLn(FSQL.GetOSName(i));
+        CellNext;
+        DumpLn(Format('%d',[os_count[i,TS]]));
+        CellNext;
+        DumpLn(Format('%3.1f',[os_count[i,TS]*100/result_count[TS]]));
+        CellNext;
+        DumpLn(FormatDetailURL(os_first_date_id[i,TS],os_first_date[i,TS]));
+        DumpLn(' '+IntToStr(FSQL.GetFailCount(os_first_date_id[i,TS])));
+        CellNext;
+        DumpLn(FormatDetailURL(os_last_date_id[i,TS],os_last_date[i,TS]));
+        DumpLn(' '+IntToStr(FSQL.GetFailCount(os_last_date_id[i,TS])));
+        CellEnd;
+        end;
+end;
+
+procedure TTestHistoryInfo.WriteVersionHistory(aHTMLWriter: THTMLWriter; TS: TTestStatus);
+
+var
+  I : integer;
+
+begin
+  if not assigned(version_count) then
+    exit;
+  for i:=0 to length(Version_count)-1 do
+    if version_count[i,TS]>0 then
+      With aHTMLWriter do
+        begin
+        RowNext;
+        CellStart;
+        CellNext;
+        DumpLn(FSQL.GetVersionName(i));
+        CellNext;
+        DumpLn(Format('%d',[version_count[i,TS]]));
+        CellNext;
+        DumpLn(Format('%3.1f',[version_count[i,TS]*100/result_count[TS]]));
+        CellNext;
+        DumpLn(FormatDetailURL(version_first_date_id[i,TS],version_first_date[i,TS]));
+        DumpLn(' '+IntToStr(FSQL.GetFailCount(version_first_date_id[i,TS])));
+        CellNext;
+        DumpLn(FormatDetailURL(version_last_date_id[i,TS], version_last_date[i,TS]));
+        DumpLn(' '+IntToStr(FSQL.GetFailCount(version_last_date_id[i,TS])));
+        CellEnd;
+        end;
+end;
+
+
+
+end.
+

tests/utils/testsuite/tshtml.pas

@@ -0,0 +1,657 @@
+unit tshtml;
+
+{$mode ObjFPC}
+{$h+}
+interface
+
+uses
+  Classes, SysUtils, wformat, dbwhtml, whtml, sqldb, tsdb, tsconsts, tssql, tsutils, tstypes;
+
+var
+  TestsuiteCGIURL : string;
+
+Type
+
+  { TTestSuiteHTMLWriter }
+
+  TTestSuiteHTMLWriter = class(THTMLWriter)
+  Private
+    FNeedEnd : Boolean;
+    FSQL : TTestSQL;
+    FComboBoxProducer:TComboBoxProducer;
+    FVars : TQueryData;
+  Public
+    constructor create(aStream : TStream; aSQL: TTestSQL; aVars : TQueryData); reintroduce;
+    destructor destroy; override;
+    // Create HTML from SQL
+    Procedure ComboBoxFromQuery(Const ComboName,Qry : String);
+    Procedure ComboBoxFromQuery(Const ComboName,Qry,Value : String);
+    Procedure ComboBoxFromQuery(Const ComboName,Qry : String; Value : integer);
+    function CreateTableProducer(DS: TSQLQuery): TTableProducer;
+    procedure DefaultTableFromQuery(Qry, ALink: String; IncludeRecordCount: Boolean);
+    // Formatting things
+    function  FormatDetailURL(const RunIdStr, CellData: String): string;
+    procedure FormatFailedOverview(Sender: TObject; var CellData: String);
+    procedure FormatTestRunOverview(Sender: TObject; var CellData: String);
+    procedure FormatSVN(Sender: TObject; var CellData: String);
+    procedure FormatSVNData(var CellData: String);
+    procedure FormatFileDetails(Sender: TObject; var CellData: String);
+    procedure FormatFileIDDetails(Sender: TObject; var CellData: String);
+    procedure FormatTestResult(Sender: TObject; var CellData: String);
+    // reate Html
+    procedure EmitHiddenVar(const Name: String; aValue: Int64); overload;
+    procedure EmitDocType;
+    procedure EmitTitle(ATitle: String);
+    procedure EmitPieImage(aOKCount, aFailedCount, aSkipCount: integer);
+    procedure EmitHistoryForm(aTitle: String);
+    procedure EmitOverviewForm(aTitle: string);
+    procedure DumpTestInfo(aInfo: TTestInfo);
+    procedure EmitEnd;
+    // In 3.2.2 the htmlwriter uses shortstring for Dumpln.
+    // LDump cuts string into 255 char pieces and writes them one by one
+    Procedure LDump(Const St : String);
+    Procedure LDumpLn(Const St : String);
+    procedure HandleVerbose(lvl: TVerboseLevel; const aMsg: String);
+ end;
+
+implementation
+
+{ TTestSuiteHTMLWriter }
+
+constructor TTestSuiteHTMLWriter.create(aStream: TStream; aSQL: TTestSQL; aVars: TQueryData);
+begin
+  Inherited Create(aStream);
+  FSQL:=ASQL;
+  FComboBoxProducer:=TComboBoxProducer.Create(Nil);
+  FVars:=aVars;
+end;
+
+destructor TTestSuiteHTMLWriter.destroy;
+begin
+  FreeAndNil(FComboBoxProducer);
+  inherited destroy;
+end;
+
+procedure TTestSuiteHTMLWriter.ComboBoxFromQuery(const ComboName, Qry: String);
+
+begin
+  ComboBoxFromQuery(ComboName,Qry,'')
+end;
+
+procedure TTestSuiteHTMLWriter.ComboBoxFromQuery(const ComboName, Qry, Value: String);
+
+Var
+  Q : TSQLQuery;
+
+begin
+  Q:=FSQL.CreateQuery(Qry);
+  try
+    Q.Open;
+    FComboboxProducer.Dataset:=Q;
+    FComboBoxProducer.ValueField:=Q.Fields[0].FieldName;
+    FComboBoxProducer.DataField:=Q.Fields[1].FieldName;
+    FComboBoxProducer.Value:=Value;
+    FComboBoxProducer.InputName:=ComboName;
+    FComboBoxProducer.CreateComboBox(Stream);
+  Finally
+    Q.Free;
+  end;
+end;
+
+procedure TTestSuiteHTMLWriter.ComboBoxFromQuery(const ComboName, Qry: String; Value: integer);
+begin
+  ComboBoxFromQuery(ComboName,Qry,IntToStr(Value))
+end;
+
+procedure TTestSuiteHTMLWriter.FormatFailedOverview(Sender: TObject; var CellData: String);
+
+Var
+  S: String;
+  P : TTableProducer;
+
+begin
+  P:=(Sender as TTableProducer);
+  S:=Format(SDetailsURL,[P.DataSet.FieldByName('ID').AsString]);
+  S:=S+'&failedonly=1&noskipped=1';
+  CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
+end;
+
+
+function TTestSuiteHTMLWriter.FormatDetailURL(const RunIdStr, CellData : String) : string;
+Var
+  S : String;
+begin
+  S:=Format(SDetailsURL,[RunIdStr]);
+  if FVars.OnlyFailed then
+    S:=S+'&amp;failedonly=1';
+  if FVars.NoSkipped then
+    S:=S+'&amp;noskipped=1';
+  Result:=Format('<A HREF="%s">%s</A>',[S,CellData]);
+end;
+
+procedure TTestSuiteHTMLWriter.FormatTestRunOverview(Sender: TObject; var CellData: String);
+Var
+  S: String;
+  P : TTableProducer;
+begin
+  P:=(Sender as TTableProducer);
+  S:=Format(SDetailsURL,[P.DataSet.FieldByName('RUN').AsString]);
+  if FVars.OnlyFailed then
+    S:=S+'&amp;failedonly=1';
+  if FVars.NoSkipped then
+    S:=S+'&amp;noskipped=1';
+  CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
+end;
+
+
+procedure TTestSuiteHTMLWriter.FormatSVN(Sender: TObject; var CellData: String);
+begin
+  FormatSVNData(CellData);
+end;
+
+procedure TTestSuiteHTMLWriter.FormatSVNData(var CellData: String);
+Var
+  S, Rev, SubStr, Remaining : String;
+  pos_colon, pos_sep : longint;
+begin
+  if CellData='' then
+    exit;
+  pos_sep:=pos('/', CellData);
+  if pos_sep=0 then
+    begin
+      pos_colon:=pos(':',CellData);
+      S:=ViewGitHashURL+copy(CellData,pos_colon+1,length(CellData));
+      CellData:=Format('<A HREF="%s" target="_blank">%s</A>',[S,CellData]);
+    end
+  else
+    begin
+      SubStr:=Copy(CellData,1,pos_sep-1);
+      Remaining:=Copy(CellData,pos_sep+1,length(CellData));
+      CellData:='';
+      while SubStr<>'' do
+        begin
+          pos_colon:=pos(':',SubStr);
+          Rev:=copy(SubStr,pos_colon+1,length(SubStr));
+          { Remove suffix like M for modified...}
+          while (length(Rev)>0) and (not (Rev[length(Rev)] in ['0'..'9','a'..'f','A'..'F'])) do
+            Rev:=Copy(Rev,1,length(Rev)-1);
+          S:=ViewGitHashURL+Rev;
+          CellData:=CellData+Format('<A HREF="%s" target="_blank">%s</A>',[S,SubStr]);
+          if Remaining='' then
+            SubStr:=''
+          else
+            begin
+              pos_sep:=pos('/',Remaining);
+              if pos_sep=0 then
+                pos_sep:=length(Remaining)+1;
+              CellData:=CellData+':';
+              SubStr:=Copy(Remaining,1,pos_sep-1);
+              Remaining:=Copy(Remaining,pos_sep+1,length(Remaining));
+            end;
+        end;
+    end;
+end;
+
+procedure TTestSuiteHTMLWriter.EmitHiddenVar(const Name: String; aValue: Int64);
+begin
+  if (aValue<>-1) then
+    EmitHiddenVar(Name,IntToStr(aValue));
+end;
+
+
+procedure TTestSuiteHTMLWriter.FormatFileIDDetails(Sender: TObject; var CellData: String);
+
+Var
+  S: String;
+  P : TTableProducer;
+
+begin
+  P:=(Sender as TTableProducer);
+  if FVars.VersionID<>-1 then
+    S:=Format(TestSuiteCGIURL + '?action=%d&amp;version=%d&amp;testfileid=%d',
+       [faction_show_history,FVars.VersionID,P.DataSet.FieldByName('Id').AsInteger])
+  else
+    S:=Format(TestSuiteCGIURL + '?action=%d&amp;testfileid=%s',
+       [faction_show_history,P.DataSet.FieldByName('Id').AsString]);
+  CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
+end;
+
+
+procedure TTestSuiteHTMLWriter.FormatFileDetails(Sender: TObject; var CellData: String);
+
+Var
+  S: String;
+  P : TTableProducer;
+
+begin
+  P:=(Sender as TTableProducer);
+  if FVars.CompareRunID<>-1 then
+    S:=Format(TestSuiteCGIURL + '?action=%d&amp;run1id=%d&amp;run2id=%s&amp;testfileid=%s',
+       [faction_show_one_test,FVars.RunID,FVars.CompareRunID,P.DataSet.FieldByName('Id').AsString])
+  else
+    S:=Format(TestSuiteCGIURL + '?action=%d&amp;run1id=%d&amp;testfileid=%s',
+       [faction_show_one_test,FVars.RunID,P.DataSet.FieldByName('Id').AsString]);
+  CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
+end;
+
+procedure TTestSuiteHTMLWriter.FormatTestResult(Sender: TObject; var CellData: String);
+
+Var
+  Res : longint;
+  Error:word;
+  TS : TTestStatus;
+begin
+  Val(CellData,Res,Error);
+  if (Error=0) and (Res>=longint(FirstStatus)) and
+     (Res<=longint(LastStatus)) then
+    begin
+      TS:=TTestStatus(Res);
+      CellData:=StatusText[TS];
+    end;
+end;
+
+procedure TTestSuiteHTMLWriter.EmitTitle(ATitle: String);
+
+begin
+  if FNeedEnd then
+    exit;
+  DumpLn('<HTML>');
+  DumpLn('<HEAD>');
+  DumpLn('<TITLE>'+ATitle+'</TITLE>');
+  Dumpln('<STYLE>');
+  Dumpln('.logNormal { color: green; }');
+  Dumpln('.logAbort { color: red; }');
+  Dumpln('.logError { color: red; }');
+  Dumpln('.logWarning { color: orange; }');
+  Dumpln('.logSQL { color: darkblue; font-size: small; }');
+  Dumpln('.logDebug { color: darkblue; font-size: small; }');
+  Dumpln('</STYLE>');
+  DumpLn('</HEAD>');
+
+  DumpLn('<BODY>');
+  FNeedEnd:=true;
+end;
+
+procedure TTestSuiteHTMLWriter.EmitDocType;
+begin
+  if FNeedEnd then
+    exit;
+  DumpLn('<!DOCTYPE html>');
+end;
+
+function TTestSuiteHTMLWriter.CreateTableProducer(DS: TSQLQuery): TTableProducer;
+
+begin
+  Result:=TTableProducer.Create(Nil);
+  Result.Dataset:=DS;
+end;
+
+procedure TTestSuiteHTMLWriter.DefaultTableFromQuery(Qry, ALink: String; IncludeRecordCount: Boolean);
+
+Var
+  Q : TSQLQuery;
+  lTable : TTableProducer;
+
+begin
+  If FVars.Debug then
+    Writeln('Query : '+Qry);
+  lTable:=Nil;
+  Q:=FSQL.CreateQuery(Qry);
+  try
+    Q.Open;
+    lTable:=CreateTableProducer(Q);
+    lTable.Border:=True;
+    If (Alink<>'') then
+      begin
+      lTable.CreateColumns(Nil);
+      If lTable.TableColumns.Count>0 then
+         (lTable.TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
+      end;
+    lTable.CreateTable(Stream);
+    If IncludeRecordCount then
+      DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
+  finally
+    lTable.Free;
+    Q.Free;
+  end;
+end;
+
+procedure TTestSuiteHTMLWriter.EmitPieImage(aOKCount,aFailedCount,aSkipCount : integer);
+
+const
+  sLink = 'Src="%s?action=2&amp;pietotal=%d&amp;piefailed=%d&amp;pieskipped=%d"'+
+          ' ALT="total=%d, failed=%d, skipped=%d"';
+
+begin
+  ParaGraphStart;
+  TagStart('IMG',Format(SLink,[TestsuiteCGIURL,
+                               aOKCount,aFailedCount,aSkipCount,
+                               aOKCount,aFailedCount,aSkipCount
+  ]));
+end;
+
+procedure TTestSuiteHTMLWriter.EmitHistoryForm(aTitle : String);
+
+begin
+  EmitDocType;
+  EmitTitle(aTitle);
+  HeaderStart(1);
+  DumpLn('View Test suite results');
+  HeaderEnd(1);
+  DumpLn('Please specify search criteria:');
+  FormStart(TestsuiteCGIURL,'');
+  if FVars.Debug then
+    EmitHiddenVar('DEBUGCGI', '1');
+  EmitHiddenVar('action',IntToStr(faction_show_history));
+  TableStart(2,true);
+  RowStart;
+    CellStart;
+      DumpLn('File:');
+    CellNext;
+      EmitInput('testfilename',FVars.Testfilename);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Operating system:');
+    CellNext;
+      ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',IntToStr(FVars.OSID));
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Processor:');
+    CellNext;
+      ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FVars.CPUID);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Version');
+    CellNext;
+      ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVars.VERSIONID);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Date');
+    CellNext;
+      If (FVars.Date=0) then
+        EmitInput('date','')
+      else
+        EmitInput('date',DateToStr(FVars.Date));
+    CellEnd;
+  RowNext;
+    CellStart;
+    DumpLn('Submitter');
+    CellNext;
+    If (FVars.Submitter='') then
+      EmitInput('submitter','')
+    else
+      EmitInput('submitter',FVars.Submitter);
+    CellEnd;
+  RowNext;
+    CellStart;
+    DumpLn('Machine');
+    CellNext;
+    If (FVars.Machine='') then
+      EmitInput('machine','')
+    else
+      EmitInput('machine',FVars.Machine);
+    CellEnd;
+  RowNext;
+    CellStart;
+    DumpLn('Config');
+    CellNext;
+    If (FVars.Config='') then
+      EmitInput('config','')
+    else
+      EmitInput('config',FVars.Config);
+    CellEnd;
+  RowNext;
+    CellStart;
+    DumpLn('Limit');
+    CellNext;
+    EmitInput('limit',IntToStr(FVars.Limit));
+    CellEnd;
+  RowNext;
+    CellStart;
+    DumpLn('Cond');
+    CellNext;
+    If (FVars.Cond='') then
+      EmitInput('cond','')
+    else
+      EmitInput('cond',FVars.Cond);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Category');
+    CellNext;
+      ComboBoxFromQuery('Category','SELECT TA_ID,TA_NAME FROM TESTCATEGORY ORDER BY TA_NAME',FVars.CategoryID);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Only failed tests');
+    CellNext;
+      EmitCheckBox('failedonly','1',FVars.onlyFailed);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Hide skipped tests');
+    CellNext;
+      EmitCheckBox('noskipped','1',FVars.NoSkipped);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('List all tests');
+    CellNext;
+      EmitCheckBox('listall','1',FVars.ListAll);
+    CellEnd;
+
+  RowEnd;
+  TableEnd;
+  ParaGraphStart;
+  if FVars.Debug then
+    EmitHiddenVar('DEBUGCGI', '1');
+  EmitSubmitButton('','Search');
+  EmitResetButton('','Reset form');
+  FormEnd;
+end;
+
+procedure TTestSuiteHTMLWriter.EmitOverviewForm(aTitle : string);
+
+begin
+  EmitDocType;
+  EmitTitle(aTitle);
+  HeaderStart(1);
+  DumpLn('View Test suite results');
+  HeaderEnd(1);
+  DumpLn('Please specify search criteria:');
+  FormStart(TestsuiteCGIURL,'');
+  if FVars.Debug then
+    EmitHiddenVar('DEBUGCGI', '1');
+  TableStart(2,true);
+  RowStart;
+    CellStart;
+      DumpLn('Operating system:');
+    CellNext;
+      ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',FVars.OSID);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Processor:');
+    CellNext;
+      ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FVars.CPUID);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Version');
+    CellNext;
+      ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVars.VERSIONID);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Date');
+    CellNext;
+      If (FVars.Date=0) then
+        EmitInput('date','')
+      else
+        EmitInput('date',DateToStr(FVars.Date));
+    CellEnd;
+  //if FDebug then
+    begin
+      RowNext;
+      CellStart;
+      DumpLn('Submitter');
+      CellNext;
+      If (FVars.Submitter='') then
+        EmitInput('submitter','')
+      else
+        EmitInput('submitter',FVars.Submitter);
+      CellEnd;
+     RowNext;
+      CellStart;
+      DumpLn('Machine');
+      CellNext;
+      If (FVars.Machine='') then
+        EmitInput('machine','')
+      else
+        EmitInput('machine',FVars.Machine);
+      CellEnd;
+      RowNext;
+      CellStart;
+      DumpLn('Config');
+      CellNext;
+      If (FVars.Config='') then
+        EmitInput('config','')
+      else
+        EmitInput('config',FVars.Config);
+      CellEnd;
+
+      RowNext;
+      CellStart;
+      DumpLn('Cond');
+      CellNext;
+      If (FVars.Cond='') then
+        EmitInput('cond','')
+      else
+        EmitInput('cond',FVars.Cond);
+      CellEnd;
+    end;
+  RowNext;
+    CellStart;
+      DumpLn('Category');
+    CellNext;
+      ComboBoxFromQuery('Category','SELECT TA_ID,TA_NAME FROM TESTCATEGORY ORDER BY TA_NAME',IntToStr(FVars.CategoryID));
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Only failed tests');
+    CellNext;
+      EmitCheckBox('failedonly','1',FVars.onlyFailed);
+    CellEnd;
+  RowNext;
+    CellStart;
+      DumpLn('Hide skipped tests');
+    CellNext;
+      EmitCheckBox('noskipped','1',FVars.NoSkipped);
+    CellEnd;
+  RowEnd;
+  TableEnd;
+  ParaGraphStart;
+  EmitSubmitButton('','Search');
+  EmitSubmitButton('action','View history');
+  EmitResetButton('','Reset form');
+  FormEnd;
+end;
+
+procedure TTestSuiteHTMLWriter.DumpTestInfo(aInfo: TTestInfo);
+
+  Procedure MaybeField(const aName,aValue : string);
+  begin
+    if aValue='' then exit;
+    DumpLn(aName+':');
+    DumpLn(' ');
+    DumpLn(aValue);
+    DumpLn('<BR>');
+  end;
+
+  Procedure MaybeField(const aName : string; aValue : Boolean);
+  begin
+    if not aValue then exit;
+    DumpLn('Flag ');
+    DumpLn('"'+aName+'" :');
+    DumpLn(' set');
+    DumpLn('<BR>');
+  end;
+
+  Procedure MaybeField(const aName : string; aValue : Integer);
+  begin
+    if aValue<=0 then exit;
+    MaybeField(aName,IntToStr(aValue));
+  end;
+
+begin
+  With aInfo do
+    begin
+    MaybeField('CPU',CPU);
+    MaybeField('OS',OS);
+    MaybeField('Version',Version);
+    if addDate<>0 then
+      MaybeField('Add date',FormatDateTime('yyy-mm-dd',addDate));
+    MaybeField('Version',Version);
+    MaybeField('Graph',Graph);
+    MaybeField('Interactive',Interactive);
+    MaybeField('Result',Result);
+    MaybeField('Fail',Fail);
+    MaybeField('Recompile',Recompile);
+    MaybeField('NoRun',NoRun);
+    MaybeField('NeedLibrary',NoRun);
+    MaybeField('KnownRunError',KnownRunError);
+    MaybeField('Note',Note);
+    MaybeField('Description',Description);
+    MaybeField('Opts',opts);
+    end;
+end;
+
+procedure TTestSuiteHTMLWriter.EmitEnd;
+
+begin
+  if not FNeedEnd then
+    exit;
+  DumpLn('</BODY>');
+  DumpLn('</HTML>');
+end;
+
+procedure TTestSuiteHTMLWriter.HandleVerbose(lvl: TVerboseLevel; const aMsg: String);
+
+Const
+  StyleNames : Array[TVerboseLevel] of string
+              = ('Abort','Error','Warning','Normal','Debug','SQL');
+begin
+  LDumpln(Format('<span class="log%s" >%s</span><br>',[StyleNames[lvl],aMsg]));
+end;
+
+procedure TTestsuiteHTMLWriter.LDump(Const St : String);
+
+var
+  ShortS : ShortString;
+  i,p  : longint;
+begin
+  i:=length(St);
+  p:=1;
+  while (i>255) do
+    begin
+      ShortS:=copy(St,p,255);
+      inc(p,255);
+      dec(i,255);
+      Dump(ShortS);
+    end;
+  ShortS:=Copy(St,p,255);
+  Dump(ShortS);
+end;
+
+procedure TTestsuiteHTMLWriter.LDumpLn(Const St : String);
+begin
+  LDump(St);
+  LDump(LineFeed);
+end;
+
+end.
+

tests/utils/testsuite/tssql.pas

@@ -0,0 +1,410 @@
+unit tssql;
+
+{$mode ObjFPC}
+{$h+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldb, tsdb, tsconsts;
+
+
+Type
+
+  { TQueryData }
+
+  TQueryData = Class(TObject)
+    PlatFormID,
+    RunID,
+    CompareRunID,
+    PreviousRunID,
+    NextRunID,
+    Previous2RunID,
+    Next2RunID : Int64;
+    TestFileID,
+    CPUID,
+    AllCategoryID,
+    CategoryID,
+    OSID : Integer;
+    VersionID : Integer;
+    TestFileName,
+    VersionBranch,
+    Cond,
+    Submitter,
+    Machine,
+    config : String;
+    Date : TDateTime;
+    Debug,
+    ListAll,
+    NoSkipped,
+    OnlyFailed : Boolean;
+    RunSkipCount,
+    RunFailedCount,
+    RunCount : Integer;
+    Action,
+    Limit : Integer;
+    TestLastDays : Integer;
+    procedure InitFromVars(aSQL: TTestSQL; aVars: TStrings);
+  end;
+
+  { TDBInfo }
+
+  TDBInfo = Class (TObject)
+    AllCategoryID : Integer;
+    AllCPUID : Integer;
+    AllOSID : Integer;
+    AllVersionID : Integer;
+    Function IsAllCPU(aCPUID : Integer) : boolean;
+    Function IsAllOS(aOSID : Integer) : boolean;
+    Function IsAllVersion(aVersionID : Integer) : boolean;
+  end;
+
+  { TTestSuiteSQL }
+
+  TTestSuiteSQL = class(TObject)
+    FVars : TQueryData;
+    FSQL : TTestSQL;
+    FInfo : TDBInfo;
+    constructor create(aVars : TQueryData; aSQL : TTestSQL; aDBInfo: TDBInfo);
+    function GetTestResultsSQL : String;
+    function GetTestResults : TSQLQuery;
+    function GetRunOverviewSQL : String;
+    function GetCompareRunSQL : String;
+    function GetSimpleTestResultsSQL : String;
+  private
+    class function FieldIs(aField: String; aValue: String): String;
+    class function PointerIs(aField: String; aValue: Int64; aSkipValue: Int64=-1): String;
+  end;
+
+
+
+implementation
+
+{ TQueryData }
+
+procedure TQueryData.InitFromVars(aSQL : TTestSQL; aVars: TStrings);
+
+  function GetVar(aName: string): string;
+
+  begin
+    Result:=aVars.Values[aName];
+  end;
+
+  function Int64Var(const aVar : String; const aVar2 : String = '') : Int64;
+
+  begin
+    Result:=StrToInt64Def(GetVar(aVar),-1);
+    if (Result=-1) and (aVar2<>'') then
+      Result:=StrToInt64Def(GetVar(aVar2),-1);
+  end;
+
+  function IntVar(const aVar : String; const aVar2 : String = '') : Integer;
+
+  begin
+    Result:=StrToIntDef(GetVar(aVar),-1);
+    if (Result=-1) and (aVar2<>'') then
+      Result:=StrToIntDef(GetVar(aVar2),-1);
+  end;
+
+  function StrVar(const aVar : String; const aVar2 : String = '') : string;
+  begin
+    Result:=GetVar(aVar);
+    if (Result='') and (aVar2<>'') then
+      Result:=GetVar(aVar2);
+  end;
+
+  function BoolVar(const aVar : String; const aVar2 : String = '') : Boolean;
+  var
+    S : string;
+  begin
+    S:=GetVar(aVar);
+    if (S='') and (aVar2<>'') then
+      S:=GetVar(aVar2);
+    Result:=(S='1');
+  end;
+
+Var
+  S : String;
+
+begin
+  S:=StrVar('action','TESTACTION');
+  Case S of
+    'View_history' : Action:=faction_show_history;
+    'Show/Compare' : Action:=faction_show_run_results;
+    'Compare_to_previous':  Action:=faction_compare_with_previous;
+    'Compare_to_next' : Action:=faction_compare_with_next;
+    'Compare_right_to_previous' : Action:=faction_compare2_with_previous;
+    'Compare_right_to_next' : Action:=faction_compare2_with_next;
+    'Compare_both_to_previous' : Action:=faction_compare_both_with_previous;
+    'Compare_both_to_next' : Action:=faction_compare_both_with_next;
+  else
+    Action:=StrToIntDef(S,0);
+  end;
+  Limit:=IntVar('limit','TESTLIMIT');
+  if Limit=-1 then
+    Limit:=50;
+  if Limit > MaxLimit then
+    Limit:=MaxLimit;
+  Submitter:=StrVar('submitter','TESTSUBMITTER');
+  Machine:=StrVar('machine','TESTMACHINE');
+  RunID:=Int64Var('run1id','TESTRUN');
+  TestLastDays:=IntVar('lastdays','TESTLASTDAYS');
+  if TestLastDays=-1 then
+    TestLastDays:=31;
+  S:=StrVar('date','TESTDATE');
+  if Length(S) > 0 then
+    try
+      Self.Date:=StrToDate(S);
+    except
+      Self.Date:=0;
+    end;
+  OnlyFailed:=BoolVar('failedonly','TESTFAILEDONLY');
+  NoSkipped:=BoolVar('noskipped','TESTNOSKIPPED');
+  CompareRunID:=Int64Var('run2id');
+  PreviousRunID:=Int64Var('previousrunid');
+  NextRunID:=Int64Var('nextrunid');
+  Previous2RunID:=Int64Var('previous2runid');
+  Next2RunID:=Int64Var('next2runid');
+  TestFileID:=Int64Var('testfileid');
+  TestFileName:=StrVar('testfilename');
+  RunCount:=IntVar('PIETOTAL');
+  RunSkipCount:=IntVar('PIESKIPPED');
+  RunFailedCount:=IntVar('PIEFAILED');
+  Debug:=BoolVar('DEBUGCGI');
+  ListAll:=BoolVar('listall');
+  Cond:=StrVar('cond','TESTCOND');
+  Config:=StrVar('comment','TESTCOMMENT');
+  if Config='' then
+    Config:=StrVar('config','TESTCONFIG');
+
+  // For Version,OS,CPU,Category: try integer, else try string and convert to integer.
+  VersionID:=IntVar('version','TESTVERSION');
+  if VersionID=-1 then
+    VersionID:=aSQL.GetVersionID(StrVar('version','TESTVERSION'));
+  OSID:=IntVar('os','TESTOS');
+  if OSID=-1 then
+    OSID:=aSQL.GetOSID(StrVar('os','TESTOS'));
+  CPUID:=IntVar('cpu','TESTCPU');
+  if CPUID=-1 then
+    CPUID:=aSQL.GetCPUID(StrVar('cpu','TESTCPU'));
+  CategoryID:=IntVar('category','TESTCATEGORY');
+  if CategoryID=-1 then
+    CategoryID:=aSQL.GetCategoryID(StrVar('category','TESTCATEGORY'));
+  if (TestFileID=-1) and (TestFileName<>'') then
+    TestFileID:=aSQL.GetTestID(TestFileName);
+  if (TestFileID<>-1) then
+    TestFileName:=aSQL.GetTestFileName(TestFileID);
+end;
+
+{ TDBInfo }
+
+function TDBInfo.IsAllCPU(aCPUID: Integer): boolean;
+begin
+  Result:=(aCPUID=-1) or (aCPUID=AllCPUID);
+end;
+
+function TDBInfo.IsAllOS(aOSID: Integer): boolean;
+begin
+  Result:=(aOSID=-1) or (aOSID=AllOSID);
+end;
+
+function TDBInfo.IsAllVersion(aVersionID: Integer): boolean;
+begin
+  Result:=(aVersionID=-1) or (aVersionID=AllVersionID);
+end;
+
+{ TTestSuiteSQL }
+
+class function TTestSuiteSQL.PointerIs(aField: String; aValue: Int64; aSkipValue: Int64): String;
+
+begin
+  Result:='';
+  if (aValue<0) or (aValue=aSkipValue) then
+    exit;
+  Result:=Format(' AND (%s=%d)',[aField,aValue]);
+end;
+
+class function TTestSuiteSQL.FieldIs(aField: String; aValue: String): String;
+begin
+  Result:='';
+  if aValue='' then exit;
+  Result:=Format('AND (%s = ''%s'')',[aField,TTestSQL.EscapeSQL(aValue)]);
+end;
+
+constructor TTestSuiteSQL.create(aVars: TQueryData; aSQL: TTestSQL; aDBInfo : TDBInfo);
+begin
+  FVars:=aVars;
+  FSQL:=aSQL;
+  FInfo:=aDBInfo;
+end;
+
+function TTestSuiteSQL.GetTestResultsSQL: String;
+
+var
+  S,SS : String;
+
+begin
+  SS:='SELECT TR_ID,TR_TESTRUN_FK AS Run, TR_TEST_FK, TR_OK AS OK'
+    +', TR_SKIP As Skip,TR_RESULT  As Result'
+  //S:='SELECT * '
+    +',TC_NAME AS CPU, TV_VERSION AS Version, TO_NAME AS OS'
+    +',TU_ID,TU_DATE AS Date,TU_SUBMITTER  AS Submitter'
+    +',(TU_FAILEDTOCOMPILE + TU_FAILEDTOFAIL + TU_FAILEDTORUN) AS Fails'
+    +',TP_MACHINE AS Machine,TP_CONFIG AS config'
+    +',TU_COMPILERDATE As CompDate'
+    +',TU_TESTSREVISION AS Tests_rev'
+    +',TU_RTLREVISION AS RTL_rev'
+    +',TU_COMPILERREVISION AS Compiler_rev'
+    +',TU_PACKAGESREVISION AS Packages_rev'
+    +',TO_ID,TC_ID,TV_ID'
+    +' FROM TESTRUN '
+    +' Inner join TESTPLATFORM ON (TU_PLATFORM_FK=TP_ID) '
+    +' LEFT JOIN TESTRESULTS ON  (TR_TESTRUN_FK=TU_ID)'
+    +' LEFT JOIN TESTOS ON  (TP_OS_FK=TO_ID)'
+    +' LEFT JOIN TESTCPU ON  (TP_CPU_FK=TC_ID)'
+    +' LEFT JOIN TESTVERSION ON  (TP_VERSION_FK=TV_ID)';
+  S:='';
+  S:=S+PointerIS('TR_TEST_FK',FVars.TestFileID);
+  S:=S+PointerIs('TR_TESTRUN_FK',FVars.RunID);
+  If FVars.OnlyFailed then
+    S:=S+' AND (NOT TR_OK)';
+  If FVars.NoSkipped then
+    S:=S+' AND (NOT TR_SKIP)';
+  If FVars.Cond<>'' then
+    S:=S+' AND ('+FVars.Cond+')';
+  S:=S+PointerIs('TP_CPU_FK',FVars.CPUID, FInfo.AllCPUID);
+  S:=S+PointerIs('TP_VERSION_FK',FVars.VERSIONID,FInfo.AllVersionID);
+  S:=S+PointerIs('TP_OS_FK',FVars.OSID,FInfo.AllOSID);
+  S:=S+FieldIs('TP_MACHINE',FVars.Machine);
+  S:=S+FieldIs('TP_CONFIG',FVars.Config);
+  S:=S+FieldIs('TU_SUBMITTER',FVars.Submitter);
+  if FVars.DATE<>0 then
+    S:=S+Format(' AND (TU_DATE >= ''%s'')',[FormatDateTime('YYYY-MM-DD',FVars.Date)]);
+
+  if S <> '' then
+  begin
+    Delete(S, 1, 4);
+    S:=SS + ' WHERE '+ S;
+  end
+  else
+    S:=SS;
+
+  S:=S+' ORDER BY TU_ID DESC';
+  if FVars.DATE=0 then
+    S:=S+' LIMIT '+IntToStr(FVars.Limit)
+  else
+    S:=S+' LIMIT '+IntToStr(MaxLimit);
+  Result:=S;
+end;
+
+function TTestSuiteSQL.GetTestResults: TSQLQuery;
+begin
+  Result:=FSQL.CreateQuery(GetTestResultsSQL);
+end;
+
+function TTestSuiteSQL.GetRunOverviewSQL: String;
+
+Const
+  SOverview = 'SELECT TU_ID as ID,TU_DATE as Date,TC_NAME as CPU,TO_NAME as OS,'+
+               'TV_VERSION as Version, '+
+               '(select count(*) from testresults where (TR_TESTRUN_FK=TU_ID)) as Count,'+
+               'TU_COMPILERREVISION as CompRev,'+
+               'TU_RTLREVISION as RTLRev,'+
+               'TU_PACKAGESREVISION as PackRev,'+
+               'TU_TESTSREVISION as TestsRev,'+
+               '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN) AS OK,'+
+               '(TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Failed,'+
+               '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN+'+
+                'TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Total,'+
+               'TU_SUBMITTER as Submitter, TP_MACHINE as Machine, TP_CONFIG as Comment %s '+
+              'FROM '+
+               ' TESTRUN '+
+               ' left join TESTPLATFORM on (TP_ID=TU_PLATFORM_FK) '+
+               ' left join TESTCPU on (TC_ID=TP_CPU_FK) '+
+               ' left join TESTOS on (TO_ID=TP_OS_FK) '+
+               ' left join TESTVERSION on (TV_ID=TP_VERSION_FK) '+
+               ' left join TESTCATEGORY on (TA_ID=TP_CATEGORY_FK) '+
+              '%s'+
+              'ORDER BY TU_ID DESC LIMIT %d';
+
+Var
+  SC,S : String;
+
+begin
+   S:='';
+   S:=S+PointerIs('TP_CPU_FK',FVars.CPUID,FInfo.AllCPUID);
+   S:=S+PointerIs('TP_CATEGORY_FK',FVars.CategoryID,FInfo.AllCategoryID);
+   S:=S+PointerIs('TP_VERSION_FK',FVars.VersionID);
+   S:=S+PointerIs('TP_OS_FK',FVars.OSID,FInfo.ALLOSID);
+   If (Round(FVars.Date)<>0) then
+     S:=S+Format(' AND (TU_DATE=''%s'')',[FormatDateTime('YYYY-MM-DD',FVars.Date)]);
+   S:=S+FieldIs('TU_SUBMITTER',FVars.Submitter);
+   S:=S+FieldIs('TP_MACHINE',FVars.Machine);
+   S:=S+FieldIs('TP_CONFIG',FVars.Config);
+   If FVars.Cond<>'' then
+     S:=S+' AND ('+FVars.Cond+')';
+   If (FSQL.GetCategoryName(FVars.CategoryID)<>'DB') then
+     SC:=', CONCAT(TU_COMPILERREVISION,''/'',TU_RTLREVISION,''/'', '+
+          'TU_PACKAGESREVISION,''/'',TU_TESTSREVISION) as rev'
+   else
+     SC:='';
+   If (FVars.CategoryID=-1) or (FSQL.GetCategoryName(FVars.CategoryID)='All') then
+     SC:=SC+', TA_NAME as Cat';
+
+
+  if S <> '' then
+  begin
+    Delete(S, 1, 4);
+    S:='WHERE '+ S + ' ';
+  end;
+  Result:=Format(SOverview,[SC,S,FVars.Limit]);
+end;
+
+function TTestSuiteSQL.GetCompareRunSQL: String;
+var
+  S,QRy : String;
+begin
+  If FVars.NoSkipped then
+    begin
+    Qry:='(((tr1.TR_SKIP) and (not tr2.TR_OK) and (not tr2.TR_SKIP)) or '
+       +'((not tr1.TR_OK) and (not tr1.TR_SKIP) and (tr2.TR_SKIP)) or '
+       +'((not tr1.TR_SKIP) and (not tr2.TR_SKIP))) and ';
+    end
+  else
+    Qry:='';
+  S:=Format(
+     'with tr1 as (SELECT * FROM TESTRESULTS WHERE TR_TESTRUN_FK=%d), '+
+     '     tr2 as (SELECT * FROM TESTRESULTS WHERE TR_TESTRUN_FK=%d) '+
+     ' SELECT T_ID as id,T_NAME as Filename,tr1.TR_SKIP as Run1_Skipped,'
+     +'tr2.TR_SKIP as Run2_Skipped,tr1.TR_OK as Run1_OK,'
+     +'tr2.TR_OK as Run2_OK, tr1.TR_Result as Run1_Result,'
+     +'tr2.TR_RESULT as Run2_Result '
+     +'FROM TESTS, tr2 LEFT JOIN tr1 USING (TR_TEST_FK) '
+     +'WHERE ((tr1.TR_SKIP IS NULL) or (tr2.TR_SKIP IS NULL) or '
+     +' (%s (tr1.TR_Result<>tr2.TR_Result)))'
+     +'and (T_ID=tr2.TR_TEST_FK)',[FVars.RunID,FVars.CompareRunID,Qry]);
+  Result:=S;
+end;
+
+function TTestSuiteSQL.GetSimpleTestResultsSQL: String;
+
+var
+  S : String;
+
+begin
+  S:=Format('SELECT TR_ID, TR_TESTRUN_FK AS RUN, TR_TEST_FK, TR_OK, TR_SKIP, TR_RESULT '
+            +' FROM TESTRESULTS '
+            +' WHERE  (TR_TEST_FK=%d)',[FVars.TestFileID]);
+  If FVars.OnlyFailed then
+    S:=S+' AND (TR_OK=''f'')';
+  if (FVars.comparerunid<>-1) then
+     S:=S+Format(' AND ((TR_TESTRUN_FK=%d) OR (TR_TESTRUN_FK=%d))',[FVars.runid,FVars.comparerunid])
+  else if (FVars.runid<>-1) then
+     S:=S+Format(' AND (TR_TESTRUN_FK=%d)',[FVars.runid])
+  else
+     S:=S+' ORDER BY TR_TESTRUN_FK DESC LIMIT '+IntToStr(FVars.Limit);
+  Result:=S;
+end;
+
+end.
+

tests/utils/testsuite/utests.pp

@@ -1,3106 +0,0 @@
-{$mode objfpc}
-{$h+}
-
-unit utests;
-
-interface
-
-uses
-     cgiapp,
-     sysutils,
-     pqconnection,
-     sqldb,whtml,dbwhtml,db,
-     tresults,webutil,
-     Classes,ftFont,fpimage,fpimgcanv,fpWritePng,fpcanvas;
-
-const
-  TestsuiteURLPrefix='http://www.freepascal.org/testsuite/';
-  TestsuiteBin='testsuite.cgi';
-  ViewURL='http://svn.freepascal.org/cgi-bin/viewvc.cgi/';
-  ViewRevURL='http://svn.freepascal.org/cgi-bin/viewvc.cgi?view=revision&revision=';
-  ViewGitHashURL='https://gitlab.com/freepascal.org/fpc/source/-/tree/';
-  TestsSubDir='/tests/';
-  DataBaseSubDir='/packages/fcl-db/tests/';
-
-var
-  TestsuiteCGIURL : string;
-
-Type
-
-  { TTestSuite }
-
-  TTestSuite = Class(TCgiApplication)
-  Private
-    FHTMLWriter : THtmlWriter;
-    FComboBoxProducer : TComboBoxProducer;
-    FDB : TSQLConnection;
-    FTrans : TSQLTransaction;
-    FRunID,
-    FCompareRunID,
-    FPreviousRunID,
-    FNextRunID,
-    FPrevious2RunID,
-    FNext2RunID,
-    FTestFileID,
-    FTestFileName,
-    FVersion,
-    FVersionBranch,
-    FCond,
-    FSubmitter,
-    FMachine,
-    FComment,
-    FCPU,
-    FCategory,
-    FOS  : String;
-    FViewVCURL : String;
-    FDate : TDateTime;
-    FDebug,
-    FListAll,
-    FNoSkipped,
-    FOnlyFailed : Boolean;
-    FRunSkipCount,
-    FRunFailedCount,
-    FRunCount : Integer;
-    FAction,
-    FLimit : Integer;
-    FTestLastDays : Integer;
-    FNeedEnd : boolean;
-    procedure DumpTestInfo(Q: TSQLQuery);
-    Procedure GetOverviewRowAttr(Sender : TObject; Var BGColor : String;
-                                   Var Align : THTMLAlign; Var VAlign : THTMLValign;
-                                   Var CustomAttr : String) ;
-    Procedure GetRunRowAttr(Sender : TObject; Var BGColor : String;
-                            Var Align : THTMLAlign; Var VAlign : THTMLValign;
-                            Var CustomAttr : String) ;
-    Procedure FormatFailedOverview(Sender : TObject; Var CellData : String);
-    Procedure FormatTestRunOverview(Sender : TObject; Var CellData : String);
-    Procedure FormatFileDetails(Sender: TObject; var CellData: String);
-    Procedure FormatFileIDDetails(Sender: TObject; var CellData: String);
-    Procedure FormatTestResult(Sender: TObject; var CellData: String);
-    Procedure FormatSVN(Sender: TObject; var CellData: String);
-    Procedure FormatSVNData(var CellData: String);
-    Function  FormatDetailURL(const RunIdStr, CellData : String) : string;
-
-    Procedure DoDrawPie(Img : TFPCustomImage; Skipped,Failed,Total : Integer);
-  Public
-    Function CreateDataset(Qry : String) : TSQLQuery;
-    Function CreateTableProducer(DS : TDataset) :TTableProducer;
-    Procedure DefaultTableFromQuery(Qry,ALink : String; IncludeRecordCount : Boolean);
-    Procedure ComboBoxFromQuery(Const ComboName,Qry : String);
-    Procedure ComboBoxFromQuery(Const ComboName,Qry,Value : String);
-    Function  GetSingleTon(Const Qry : String) : String;
-    Function GetOSName(ID : String) : String;
-    Function GetOSID(AName : String) : String;
-    Function GetCPUName(ID : String) : String;
-    Function GetCPUID(AName : String) : String;
-    Function GetVersionName(ID : String) : String;
-    Function GetCategoryName(ID : String) : String;
-    Function GetTestFileName(ID : String) : String;
-    Function GetPreviousRunID(RunID : String) : String;
-    Function GetNextRunID(RunID : String) : String;
-    Function GetFailCount(RunID : longint) : string;
-    Function InitCGIVars : Integer;
-    Procedure DoRun; override;
-    Procedure EmitDocType;
-    Procedure EmitOverviewForm;
-    Procedure EmitHistoryForm;
-    Procedure ShowRunResults;
-    Procedure ShowRunComparison;
-    Procedure ShowOneTest;
-    Procedure ShowHistory;
-    Function ConnectToDB : Boolean;
-    procedure DisconnectFromDB;
-    Procedure EmitTitle(ATitle : String);
-    Procedure EmitEnd;
-    Procedure ShowRunOverview;
-    Procedure CreateRunPie;
-    Function  ShowRunData : Boolean;
-    Procedure LDump(Const St : String);
-    Procedure LDumpLn(Const St : String);
-
-
-  end;
-
-implementation
-
-
-  uses
-    wformat,
-    dateutils;
-
-Const
-{$i utests.cfg}
-
-{ if utests.cfg is missed, create one with the following contents:
-  DefDatabase = 'TESTSUITE';
-  DefHost     = '';
-  DefDBUser   = ''; // fill this in when compiling.
-  DefPassword = ''; // fill this in, too.
-}
-
-Const
-  OldTestResultsTableName = 'OLDTESTRESULTS';
-  NewTestResultsTableName = 'TESTRESULTS';
-  LastOldTestRun = 91178;
-  MaxLimit = 1000;
-  UseGit = True;
-
-const
-  faction_show_overview = 0;
-  faction_show_run_results = 1;
-  faction_show_run_pie = 2;
-  faction_show_one_test = 3;
-  faction_show_history = 4;
-  faction_compare_with_previous = 5;
-  faction_compare_with_next = 6;
-  faction_compare2_with_previous = 7;
-  faction_compare2_with_next = 8;
-  faction_compare_both_with_previous = 9;
-  faction_compare_both_with_next = 10;
-
-
-  Function TestResultsTableName(const RunId : String) : string;
-  var
-    RunIDVal : qword;
-    Error : word;
-  begin
-    system.val (Trim(RunId),RunIdVal,error);
-    if (error<>0) then
-      result:='ErrorTable'
-    else if (RunIdVal <= LastOldTestRun) then
-      result:=OldTestResultsTableName
-    else
-      result:=NewTestResultsTableName;
-  end;
-
-
-Var
-  SDetailsURL : string;
-
-type
-  known_versions = (
-    ver_unknown,
-    ver_1_0_10,
-    ver_2_0_0,
-    ver_2_0_1,
-    ver_2_0_2,
-    ver_2_0_3,
-    ver_2_0_4,
-    ver_2_0_5,
-    ver_2_1_2,
-    ver_2_1_4,
-    ver_2_2_0,
-    ver_2_2_1,
-    ver_2_2_2,
-    ver_2_2_3,
-    ver_2_2_4,
-    ver_2_2_5,
-    ver_2_3_1,
-    ver_2_4_0,
-    ver_2_4_1,
-    ver_2_4_2,
-    ver_2_4_3,
-    ver_2_4_4,
-    ver_2_4_5,
-    ver_2_5_1,
-    ver_2_6_0,
-    ver_2_6_1,
-    ver_2_6_2,
-    ver_2_6_3,
-    ver_2_6_4,
-    ver_2_6_5,
-    ver_2_7_1,
-    ver_3_0_0,
-    ver_3_0_1,
-    ver_3_0_2,
-    ver_3_0_3,
-    ver_3_0_4,
-    ver_3_0_5,
-    ver_3_1_1,
-    ver_3_2_0,
-    ver_3_2_1,
-    ver_3_2_2,
-    ver_3_2_3,
-    ver_3_3_1);
-
-const
-  ver_trunk = high (known_versions);
-
-const
-  ver_string : array[known_versions] of string =
-  (
-   'unknown',
-   '1.0.10',
-   '2.0.0',
-   '2.0.1',
-   '2.0.2',
-   '2.0.3',
-   '2.0.4',
-   '2.0.5',
-   '2.1.2',
-   '2.1.4',
-   '2.2.0',
-   '2.2.1',
-   '2.2.2',
-   '2.2.3',
-   '2.2.4',
-   '2.2.5',
-   '2.3.1',
-   '2.4.0',
-   '2.4.1',
-   '2.4.2',
-   '2.4.3',
-   '2.4.4',
-   '2.4.5',
-   '2.5.1',
-   '2.6.0',
-   '2.6.1',
-   '2.6.2',
-   '2.6.3',
-   '2.6.4',
-   '2.6.5',
-   '2.7.1',
-   '3.0.0',
-   '3.0.1',
-   '3.0.2',
-   '3.0.3',
-   '3.0.4',
-   '3.0.5',
-   '3.1.1',
-   '3.2.0',
-   '3.2.1',
-   '3.2.2',
-   '3.2.3',
-   '3.3.1'
-  );
-
-  ver_branch : array [known_versions] of string =
-  (
-   '',
-   '',
-   'tags/release_2_0_0',
-   'branches/fixes_2_0',
-   'tags/release_2_0_2',
-   'branches/fixes_2_0',
-   'tags/release_2_0_4',
-   'branches/fixes_2_0',
-   'tags/release_2_1_2',
-   'tags/release_2_1_4',
-   'tags/release_2_2_0',
-   'branches/fixes_2_2',
-   'tags/release_2_2_2',
-   'branches/fixes_2_2',
-   'tags/release_2_2_4',
-   'branches/fixes_2_2',
-   'branches/fixes_2_2',
-   'tags/release_2_4_0',
-   'tags/release_2_4_0',
-   'tags/release_2_4_2',
-   'tags/release_2_4_2',
-   'tags/release_2_4_4',
-   'tags/release_2_4_4',
-   'branches/fixes_2_4',
-   'tags/release_2_6_0',
-   'tags/release_2_6_0',
-   'tags/release_2_6_2',
-   'tags/release_2_6_2',
-   'tags/release_2_6_4',
-   'tags/release_2_6_4',
-   'branches/fixes_2_6',
-   'tags/release_3_0_0',
-   'tags/release_3_0_0',
-   'tags/release_3_0_2',
-   'tags/release_3_0_2',
-   'tags/release_3_0_4',
-   'tags/release_3_0_4',
-   'branches/fixes_3_0',
-   'tags/release_3_2_0',
-   'tags/release_3_2_0',
-   'tags/release_3_2_2',
-   'branches/fixes_3_2',
-   'trunk'
-  );
-
-Procedure TTestSuite.DoRun;
-
-begin
-  Try
-    Try
-      Case InitCGIVars of
-        faction_show_overview : EmitOverviewForm;
-        faction_show_run_results :
-          if Length(FCompareRunID) = 0 then
-            ShowRunResults
-          else
-            ShowRunComparison;
-        faction_show_run_pie : CreateRunPie;
-        faction_show_one_test : ShowOneTest;
-        faction_show_history : ShowHistory;
-        faction_compare_with_previous : 
-          begin
-            FCompareRunID:=FRunID;
-            FRunID:=FPreviousRunID;
-            ShowRunComparison;
-          end;
-        faction_compare_with_next : 
-          begin
-            FCompareRunID:=FNextRunID;
-            ShowRunComparison;
-          end;
-        faction_compare2_with_previous : 
-          begin
-            FRunID:=FPrevious2RunID;
-            ShowRunComparison;
-          end;
-        faction_compare2_with_next : 
-          begin
-            FRunID:=FCompareRunID;
-            FCompareRunID:=FNext2RunID;
-            ShowRunComparison;
-          end;
-        faction_compare_both_with_previous : 
-          begin
-            FRunID:=FPreviousRunID;
-            FCompareRunID:=FPrevious2RunID;
-            ShowRunComparison;
-          end;
-        faction_compare_both_with_next : 
-          begin
-            FRunID:=FNextRunID;
-            FCompareRunID:=FNext2RunID;
-            ShowRunComparison;
-          end;
-{$ifdef TEST}
-        98 :
-          begin
-            ///EmitOverviewForm;
-            system.Writeln(stdout,'<PRE>');
-            system.Writeln(stdout,'paramstr(0) is ',paramstr(0));
-            system.FreeMem(pointer($ffffffff));
-            system.Writeln(stdout,'</PRE>');
-            system.Flush(stdout);
-          end;
-        99 :
-          begin
-            EmitOverviewForm;
-            system.Writeln(stdout,'<PRE>');
-            system.Dump_stack(stdout,get_frame);
-            system.Writeln(stdout,'</PRE>');
-            system.Flush(stdout);
-          end;
-{$endif TEST}
-        end;
-    finally
-      EmitEnd;
-      DisConnectFromDB;
-    end;
-  Finally
-    Terminate;
-  end;
-end;
-
-
-Function TTestSuite.InitCGIVars : Integer;
-
-Var
-  S : String;
-
-begin
-  FHtmlWriter:=THTMLWriter.Create(Response);
-  FComboBoxProducer:=TComboBoxProducer.Create(Self);
-  DateSeparator:='/';
-  Result:=0;
-  S:=RequestVariables['action'];
-  if Length(S) = 0 then
-    S:=RequestVariables['TESTACTION'];
-  if S='View_history' then
-    FAction:=faction_show_history
-  else if S='Show/Compare' then
-    FAction:=faction_show_run_results
-  else if S='Compare_to_previous' then
-    FAction:=faction_compare_with_previous
-  else if S='Compare_to_next' then
-    FAction:=faction_compare_with_next
-  else if S='Compare_right_to_previous' then
-    FAction:=faction_compare2_with_previous
-  else if S='Compare_right_to_next' then
-    FAction:=faction_compare2_with_next
-  else if S='Compare_both_to_previous' then
-    FAction:=faction_compare_both_with_previous
-  else if S='Compare_both_to_next' then
-    FAction:=faction_compare_both_with_next
-  else
-    FAction:=StrToIntDef(S,0);
-  S:=RequestVariables['limit'];
-  if Length(S) = 0 then
-    S:=RequestVariables['TESTLIMIT'];
-  FLimit:=StrToIntDef(S,50);
-  if FLimit > MaxLimit then
-    FLimit:=MaxLimit;
-  FVersion:=RequestVariables['version'];
-  if Length(FVersion) = 0 then
-    FVersion:=RequestVariables['TESTVERSION'];
-  TestsuiteCGIURL:=Self.ScriptName;
-  SDetailsURL := TestsuiteCGIURL + '?action=1&amp;run1id=%s';
-  FOS:=RequestVariables['os'];
-  if Length(FOS) = 0 then
-    FOS:=RequestVariables['TESTOS'];
-  FCPU:=RequestVariables['cpu'];
-  if Length(FCPU) = 0 then
-    FCPU:=RequestVariables['TESTCPU'];
-  FCategory:=RequestVariables['category'];
-  if Length(FCategory) = 0 then
-    FCategory:=RequestVariables['TESTCATEGORY'];
-  FCond:=RequestVariables['cond'];
-  if Length(FCond) = 0 then
-    FCond:=RequestVariables['TESTCOND'];
-  FComment:=RequestVariables['comment'];
-  if Length(FComment) = 0 then
-    FComment:=RequestVariables['TESTCOMMENT'];
-  FSubmitter:=RequestVariables['submitter'];
-  if Length(FSubmitter) = 0 then
-    FSubmitter:=RequestVariables['TESTSUBMITTER'];
-  FMachine:=RequestVariables['machine'];
-  if Length(FMachine) = 0 then
-    FMachine:=RequestVariables['TESTMACHINE'];
-
-  FRunID:=RequestVariables['run1id'];
-  if Length(FRunID) = 0 then
-    FRunID:=RequestVariables['TESTRUN'];
-  S:=RequestVariables['lastdays'];
-  if Length(S) = 0 then
-    S:=RequestVariables['TESTLASTDAYS'];
-  FTestLastDays:=StrToIntDef(S,31);
-  S:=RequestVariables['date'];
-  if Length(S) = 0 then
-    S:=RequestVariables['TESTDATE'];
-  if Length(S) > 0 then
-    try
-      FDate:=StrToDate(S);
-    except
-      FDate:=0;
-    end;
-  S:=RequestVariables['failedonly'];
-  if Length(S) = 0 then
-    S:=RequestVariables['TESTFAILEDONLY'];
-  FOnlyFailed:=(S='1');
-  S:=RequestVariables['noskipped'];
-  if Length(S) = 0 then
-    S:=RequestVariables['TESTNOSKIPPED'];
-  FNoSkipped:=(S='1');
-  FCompareRunID:=RequestVariables['run2id'];
-  FPreviousRunID:=RequestVariables['previousrunid'];
-  FNextRunID:=RequestVariables['nextrunid'];
-  FPrevious2RunID:=RequestVariables['previous2runid'];
-  FNext2RunID:=RequestVariables['next2runid'];
-  FTestFileID:=RequestVariables['testfileid'];
-  FTestFileName:=RequestVariables['testfilename'];
-  FRunCount:=StrToIntDef(RequestVariables['PIETOTAL'],0);
-  FRunSkipCount:=StrToIntDef(RequestVariables['PIESKIPPED'],0);
-  FRunFailedCount:=StrToIntDef(RequestVariables['PIEFAILED'],0);
-  S:=RequestVariables['DEBUGCGI'];
-  FDebug:=(S='1');
-  S:=RequestVariables['listall'];
-  FListAll:=(S='1');
-  Result:=FAction;
-end;
-
-Function TTestSuite.ConnectToDB : Boolean;
-
-begin
-  Result:=False;
-  FDB:=TPQConnection.Create(Self);
-  FDB.HostName:=DefHost;
-  FDB.DatabaseName:=DefDatabase;
-  FDB.UserName:=DefDBUser;
-  FDB.Password:=DefPassword;
-  FTrans := TSQLTransaction.Create(nil);
-  FTrans.DataBase := FDB;
-  FDB.Transaction := FTrans;
-  FDB.Connected:=True;
-  Result:=True;
-  { All is not the first anymore, we need to put it by default explicity }
-  if Length(FOS) = 0 then
-    FOS:=GetOSID('All');
-  { All is not the first anymore, we need to put it by default explicity }
-  if Length(FCPU) = 0 then
-    FCPU:=GetCPUID('All');
-end;
-
-procedure TTestsuite.LDump(Const St : String);
-var
-  S : String;
-  ShortS : ShortString;
-  i,p  : longint;
-begin
-  i:=length(St);
-  p:=1;
-  while (i>255) do 
-    begin
-      ShortS:=copy(St,p,255);
-      inc(p,255);
-      dec(i,255);
-      FHTMLWriter.Dump(ShortS);
-    end;
-  ShortS:=Copy(St,p,255);
-  FHTMLWriter.Dump(ShortS);
-end;
-
-procedure TTestsuite.LDumpLn(Const St : String);
-begin
-  LDump(St);
-  LDump(LineFeed);
-end;
-
-procedure TTestSuite.DisconnectFromDB;
-
-begin
-  If Assigned(FDB) then
-    begin
-    if (FDB.Connected) then
-      FDB.Connected:=False;
-    FreeAndNil(FDB);
-    FreeAndNil(FTrans);
-    end;
-end;
-
-Procedure TTestSuite.ComboBoxFromQuery(Const ComboName,Qry: String);
-
-begin
-  ComboBoxFromQuery(ComboName,Qry,'')
-end;
-
-Procedure TTestSuite.ComboBoxFromQuery(Const ComboName,Qry,Value : String);
-
-Var
-  Q : TSQLQuery;
-
-begin
-  Q:=TSQLQuery.Create(Self);
-  try
-    Q.Database:=FDB;
-    Q.Transaction:=FTrans;
-    Q.SQL.Text:=Qry;
-    Q.Open;
-    FComboboxProducer.Dataset:=Q;
-    FComboBoxProducer.ValueField:=Q.Fields[0].FieldName;
-    FComboBoxProducer.DataField:=Q.Fields[1].FieldName;
-    FComboBoxProducer.Value:=Value;
-    FComboBoxProducer.InputName:=ComboName;
-    FComboBoxProducer.CreateComboBox(Response);
-  Finally
-    Q.Free;
-  end;
-end;
-
-Function TTestSuite.GetSingleton(Const Qry : String) : String;
-
-Var
-  Q : TSQLQuery;
-
-begin
-  Result:='';
-  if FDEbug then
-    begin
-      system.Writeln('Query=',Qry);
-      system.flush(output);
-    end;
-  Q:=TSQLQuery.Create(Self);
-  try
-    Q.Database:=FDB;
-    Q.Transaction:=FTrans;
-    Q.SQL.Text:=Qry;
-    Q.Open;
-    Try
-      if FDebug and (Q.FieldCount<>1) then
-        begin
-          system.Writeln('GetSingleton number of fields is not 1, but ',
-            Q.FieldCount);
-          system.flush(output);
-        end;
-      If Not (Q.EOF and Q.BOF) then
-        Result:=Q.Fields[0].AsString;
-    Finally
-      Q.Close;
-    end;
-  finally
-    Q.Free;
-  end;
-end;
-
-Procedure TTestSuite.EmitTitle(ATitle : String);
-
-Var
-  S : TStrings;
-begin
-  AddResponseLn('<HTML>');
-  AddResponseLn('<TITLE>'+ATitle+'</TITLE>');
-  AddResponseLn('<BODY>');
-  FNeedEnd:=true;
-end;
-
-Procedure TTestSuite.EmitDocType;
-begin
-  AddResponseLn('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" '+
-     '"http://www.w3.org/TR/html4/loose.dtd">');
-end;
-
-Procedure TTestSuite.EmitOverviewForm;
-
-begin
-  ConnectToDB;
-  ContentType:='text/html';
-  EmitContentType;
-  EmitDocType;
-  EmitTitle(Title);
-  With FHTMLWriter do
-    begin
-    HeaderStart(1);
-    DumpLn('View Test suite results');
-    HeaderEnd(1);
-    DumpLn('Please specify search criteria:');
-    FormStart(TestsuiteCGIURL,'');
-    if FDebug then
-      EmitHiddenVar('DEBUGCGI', '1');
-
-    TableStart(2,true);
-    RowStart;
-      CellStart;
-        DumpLn('Operating system:');
-      CellNext;
-        ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',FOS);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Processor:');
-      CellNext;
-        ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FCPU);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Version');
-      CellNext;
-        ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVERSION);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Date');
-      CellNext;
-        If (FDate=0) then
-          EmitInput('date','')
-        else
-          EmitInput('date',DateToStr(FDate));
-      CellEnd;
-    //if FDebug then
-      begin
-        RowNext;
-        CellStart;
-        DumpLn('Submitter');
-        CellNext;
-        If (FSubmitter='') then
-          EmitInput('submitter','')
-        else
-          EmitInput('submitter',FSubmitter);
-        CellEnd;
-       RowNext;
-        CellStart;
-        DumpLn('Machine');
-        CellNext;
-        If (FMachine='') then
-          EmitInput('machine','')
-        else
-          EmitInput('machine',FMachine);
-        CellEnd;
-        RowNext;
-        CellStart;
-        DumpLn('Comment');
-        CellNext;
-        If (FComment='') then
-          EmitInput('comment','')
-        else
-          EmitInput('comment',FComment);
-        CellEnd;
-
-        RowNext;
-        CellStart;
-        DumpLn('Cond');
-        CellNext;
-        If (FCond='') then
-          EmitInput('cond','')
-        else
-          EmitInput('cond',FCond);
-        CellEnd;
-      end;
-    RowNext;
-      CellStart;
-        DumpLn('Category');
-      CellNext;
-        ComboBoxFromQuery('Category','SELECT TCAT_ID,TCAT_NAME FROM TESTCATEGORY ORDER BY TCAT_NAME',FCategory);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Only failed tests');
-      CellNext;
-        EmitCheckBox('failedonly','1',FonlyFailed);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Hide skipped tests');
-      CellNext;
-        EmitCheckBox('noskipped','1',FNoSkipped);
-      CellEnd;
-    RowEnd;
-    TableEnd;
-    ParaGraphStart;
-    EmitSubmitButton('','Search');
-    EmitSubmitButton('action','View history');
-
-    EmitResetButton('','Reset form');
-    FormEnd;
-    end;
-  ShowRunOverview;
-end;
-
-Procedure TTestSuite.EmitHistoryForm;
-
-begin
-  ConnectToDB;
-  ContentType:='text/html';
-  EmitContentType;
-  EmitDocType;
-  EmitTitle(Title);
-  With FHTMLWriter do
-    begin
-    HeaderStart(1);
-    DumpLn('View Test suite results');
-    HeaderEnd(1);
-    DumpLn('Please specify search criteria:');
-    FormStart(TestsuiteCGIURL,'');
-    if FDebug then
-      EmitHiddenVar('DEBUGCGI', '1');
-    EmitHiddenVar('action',IntToStr(faction_show_history));
-    TableStart(2,true);
-    RowStart;
-      CellStart;
-        DumpLn('File:');
-      CellNext;
-        EmitInput('testfilename',FTestfilename);
-      CellEnd;
-    RowNext;
-    (*   CellStart;
-        DumpLn('FileID:');
-      CellNext;
-        EmitInput('testfileid',FTestfileid);
-      CellEnd;
-    RowNext; *)
-
-      CellStart;
-        DumpLn('Operating system:');
-      CellNext;
-        ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',FOS);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Processor:');
-      CellNext;
-        ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FCPU);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Version');
-      CellNext;
-        ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVERSION);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Date');
-      CellNext;
-        If (FDate=0) then
-          EmitInput('date','')
-        else
-          EmitInput('date',DateToStr(FDate));
-      CellEnd;
-        RowNext;
-        CellStart;
-        DumpLn('Submitter');
-        CellNext;
-        If (FSubmitter='') then
-          EmitInput('submitter','')
-        else
-          EmitInput('submitter',FSubmitter);
-        CellEnd;
-       RowNext;
-        CellStart;
-        DumpLn('Machine');
-        CellNext;
-        If (FMachine='') then
-          EmitInput('machine','')
-        else
-          EmitInput('machine',FMachine);
-        CellEnd;
-        RowNext;
-        CellStart;
-        DumpLn('Comment');
-        CellNext;
-        If (FComment='') then
-          EmitInput('comment','')
-        else
-          EmitInput('comment',FComment);
-        CellEnd;
-        RowNext;
-        CellStart;
-        DumpLn('Limit');
-        CellNext;
-        EmitInput('limit',IntToStr(FLimit));
-        CellEnd;
-
-        RowNext;
-        CellStart;
-        DumpLn('Cond');
-        CellNext;
-        If (FCond='') then
-          EmitInput('cond','')
-        else
-          EmitInput('cond',FCond);
-        CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Category');
-      CellNext;
-        ComboBoxFromQuery('Category','SELECT TCAT_ID,TCAT_NAME FROM TESTCATEGORY ORDER BY TCAT_NAME',FCategory);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Only failed tests');
-      CellNext;
-        EmitCheckBox('failedonly','1',FonlyFailed);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('Hide skipped tests');
-      CellNext;
-        EmitCheckBox('noskipped','1',FNoSkipped);
-      CellEnd;
-    RowNext;
-      CellStart;
-        DumpLn('List all tests');
-      CellNext;
-        EmitCheckBox('listall','1',FListAll);
-      CellEnd;
-
-    RowEnd;
-    TableEnd;
-    ParaGraphStart;
-    if FDebug then
-      EmitHiddenVar('DEBUGCGI', '1');
-    EmitSubmitButton('','Search');
-    EmitResetButton('','Reset form');
-    FormEnd;
-    end;
-end;
-
-
-procedure TTestSuite.EmitEnd;
-begin
-  if not FNeedEnd then
-    exit;
-  AddResponseLn('</BODY>');
-  AddResponseLn('</HTML>');
-end;
-
-procedure TTestSuite.GetOverviewRowAttr(Sender: TObject; var BGColor: String;
-  var Align: THTMLAlign; var VAlign: THTMLValign; var CustomAttr: String);
-begin
-  If ((Sender as TTAbleProducer).CurrentRow mod 2=0) then
-    BGColor:='#EEEEEE'
-end;
-
-
-Function TTestSuite.CreateDataset(Qry : String) : TSQLQuery;
-
-begin
-  Result:=TSQLQuery.Create(Self);
-  With Result do
-    begin
-    Database:=FDB;
-    Transaction := FTrans;
-    SQL.Text:=Qry;
-    end;
-end;
-
-Function TTestSuite.CreateTableProducer(DS : TDataset) :TTableProducer;
-
-begin
-  Result:=TTableProducer.Create(Self);
-  Result.Dataset:=DS;
-end;
-
-Procedure TTestSuite.DefaultTableFromQuery(Qry,Alink : String; IncludeRecordCount : Boolean);
-
-Var
-  Q : TSQLQuery;
-
-begin
-  If FDebug then
-    Writeln('Query : '+Qry);
-  Q:=CreateDataset(Qry);
-  With Q do
-    try
-      Open;
-      Try
-        With CreateTableProducer(Q) do
-          Try
-            Border:=True;
-            If (Alink<>'') then
-              begin
-              CreateColumns(Nil);
-              If TableColumns.Count>0 then
-                (TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
-              end;
-            CreateTable(Response);
-          Finally
-            Free;
-          end;
-        If IncludeRecordCount then
-          FHTMLWriter.DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
-      Finally
-        Close;
-      end;
-    finally
-      Free;
-    end;
-end;
-
-Procedure TTestSuite.ShowRunOverview;
-Const
-  SOverview = 'SELECT TU_ID as ID,TU_DATE as Date,TC_NAME as CPU,TO_NAME as OS,'+
-               'TV_VERSION as Version,(select count(*) from testresults where (TR_TESTRUN_FK=TU_ID)) as Count,'+
-               'TU_SVNCOMPILERREVISION as SvnCompRev,'+
-               'TU_SVNRTLREVISION as SvnRTLRev,'+
-               'TU_SVNPACKAGESREVISION as SvnPackRev,TU_SVNTESTSREVISION as SvnTestsRev,'+
-               '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN) AS OK,'+
-               '(TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Failed,'+
-               '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN+'+
-                'TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Total,'+
-               'TU_SUBMITTER as Submitter, TU_MACHINE as Machine, TU_COMMENT as Comment %s '+
-              'FROM '+
-               ' TESTRUN '+
-               ' left join TESTCPU on (TC_ID=TU_CPU_FK) '+
-               ' left join TESTOS on (TO_ID=TU_OS_FK) '+
-               ' left join TESTVERSION on (TV_ID=TU_VERSION_FK) '+
-               ' left join TESTCATEGORY on (TCAT_ID=TU_CATEGORY_FK) '+
-              '%s'+
-              'ORDER BY TU_ID DESC LIMIT %d';
-
-
-Var
-  SC,S,A,Qry : String;
-  Q : TSQLQuery;
-
-begin
-   S:='';
-   If (FCPU<>'') and (GetCPUName(FCPU)<>'All') then
-     S:=S+' AND (TU_CPU_FK='+FCPU+')';
-   If (FCategory<>'') and (GetCategoryName(FCategory)<>'All') then
-     S:=S+' AND (TU_CATEGORY_FK='+FCategory+')';
-   If (FVersion<>'') and (GetVersionName(FVersion)<>'All')  then
-     S:=S+' AND (TU_VERSION_FK='+FVERSION+')';
-   if (FOS<>'') and (GetOSName(FOS)<>'All') then
-     S:=S+' AND (TU_OS_FK='+FOS+')';
-   If (Round(FDate)<>0) then
-     S:=S+' AND (to_char(TU_DATE, ''YYYY-MM-DD'') LIKE '''+FormatDateTime('YYYY-MM-DD',FDate)+'%'')';
-   If FSubmitter<>'' then
-     S:=S+' AND (TU_SUBMITTER='''+FSubmitter+''')';
-   If FMachine<>'' then
-     S:=S+' AND (TU_MACHINE='''+FMachine+''')';
-   If FComment<>'' then
-     S:=S+' AND (TU_COMMENT LIKE '''+Fcomment+''')';
-   If FCond<>'' then
-     S:=S+' AND ('+FCond+')';
-   If GetCategoryName(FCategory)<>'DB' then
-     SC:=', CONCAT(TU_SVNCOMPILERREVISION,''/'',TU_SVNRTLREVISION,''/'', '+
-          'TU_SVNPACKAGESREVISION,''/'',TU_SVNTESTSREVISION) as svnrev'
-   else
-     SC:='';
-   If (FCategory='') or (GetCategoryName(FCategory)='All') then
-     SC:=SC+', TCAT_NAME as Cat';
-
-   A:=SDetailsURL;
-   If FOnlyFailed then
-     A:=A+'&amp;failedonly=1';
-   If FNoSkipped then
-     A:=A+'&amp;noskipped=1';
-     
-  if S <> '' then
-  begin
-    Delete(S, 1, 4);
-    S:='WHERE '+ S + ' ';
-  end;
-  Qry:=Format(SOverview,[SC,S,FLimit]);
-  If FDebug then
-    Writeln('Query : '+Qry);
-  Q:=CreateDataset(Qry);
-  With Q do
-    try
-      Open;
-      Try
-        With CreateTableProducer(Q) do
-          Try
-            Border:=True;
-            OnGetRowAttributes:=@GetOverViewRowAttr;
-            CreateColumns(Nil);
-            TableColumns.ColumnByName('ID').ActionURL:=A;
-            TableColumns.ColumnByNAme('Failed').OnGetCellContents:=@FormatFailedOverview;
-            TableColumns.ColumnByNAme('svnrev').OnGetCellContents:=@FormatSVN;
-            TableColumns.ColumnByNAme('svncomprev').OnGetCellContents:=@FormatSVN;
-            TableColumns.ColumnByNAme('svnrtlrev').OnGetCellContents:=@FormatSVN;
-            TableColumns.ColumnByNAme('svnpackrev').OnGetCellContents:=@FormatSVN;
-            TableColumns.ColumnByNAme('svntestsrev').OnGetCellContents:=@FormatSVN;
-            CreateTable(Response);
-          Finally
-            Free;
-          end;
-        FHTMLWriter.DumpLn(Format('<p>Record count: %d</p>',[Q.RecordCount]));
-      Finally
-        Close;
-      end;
-    finally
-      Free;
-    end;
-end;
-
-
-Function TTestSuite.GetOSName(ID : String) : String;
-
-begin
-  if (ID<>'') then
-    Result:=GetSingleTon('SELECT TO_NAME FROM TESTOS WHERE TO_ID='+ID)
-  else
-    Result:='';
-end;
-
-Function TTestSuite.GetOSID(AName : String) : String;
-
-begin
-  if (AName<>'') then
-    Result:=GetSingleTon('SELECT TO_ID FROM TESTOS WHERE TO_NAME='''+Aname+'''')
-  else
-    Result:='';
-end;
-
-Function TTestSuite.GetTestFileName(ID : String) : String;
-
-begin
-  if (ID<>'') then
-    Result:=GetSingleTon('SELECT T_NAME FROM TESTS WHERE T_ID='+ID)
-  else
-    Result:='';
-end;
-
-Function TTestsuite.GetFailCount(RunID : longint) : string;
-begin
-  if RunID<>0 then
-    Result:=GetSingleTon('SELECT (TU_FAILEDTOCOMPILE + TU_FAILEDTOFAIL + TU_FAILEDTORUN) FROM TESTRUN WHERE TU_ID='+IntToStr(RunID))
-  else
-    Result:='';
-end;
-
-Function TTestSuite.GetCPUName(ID : String) : String;
-
-begin
-  if (ID<>'') then
-    Result:=GetSingleTon('SELECT TC_NAME FROM TESTCPU WHERE TC_ID='+ID)
-  else
-    Result:='';
-end;
-
-Function TTestSuite.GetCPUID(AName : String) : String;
-
-begin
-  if (AName<>'') then
-    Result:=GetSingleTon('SELECT TC_ID FROM TESTCPU WHERE TC_NAME='''+AName+'''')
-  else
-    Result:='';
-end;
-
-Function TTestSuite.GetVersionName(ID : String) : String;
-
-begin
-  if (ID<>'') then
-    Result:=GetSingleton('SELECT TV_VERSION FROM TESTVERSION WHERE TV_ID='+ID)
-  else
-    Result:='';
-end;
-
-Function TTestSuite.GetCategoryName(ID : String) : String;
-
-begin
-  if (ID<>'') then
-    Result:=GetSingleton('SELECT TCAT_NAME FROM TESTCATEGORY WHERE TCAT_ID='+ID)
-  else
-    Result:='';
-end;
-
-Function TTestSuite.GetPreviousRunID(RunID : String) : String;
-
-begin
-  if (RunID<>'') then
-    Result:=GetSingleton('SELECT TH_PREVIOUS_FK FROM TESTRUNHISTORY WHERE TH_ID_FK='+RunID)
-  else
-    Result:='';
-end;
-
-Function TTestSuite.GetNextRunID(RunID : String) : String;
-
-begin
-  if (RunID<>'') then
-    Result:=GetSingleton('SELECT TH_ID_FK FROM TESTRUNHISTORY WHERE TH_PREVIOUS_FK='+RunID)
-  else
-    Result:='';
-end;
-
-Function TTestSuite.ShowRunData : Boolean;
-
-Const
-  SGetRunData = 'SELECT TU_ID,TU_DATE,TC_NAME,TO_NAME,' +
-                'TU_SUBMITTER,TU_MACHINE,TU_COMMENT,TV_VERSION,'+
-                'TU_CATEGORY_FK,TU_SVNCOMPILERREVISION,TU_SVNRTLREVISION,'+
-                'TU_COMPILERDATE,TU_COMPILERFULLVERSION,'+
-                'TU_SVNPACKAGESREVISION,TU_SVNTESTSREVISION,'+
-               '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN) AS OK,'+
-               '(TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Failed,'+
-               '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN+'+
-                'TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Total'+
-
-                ' %s FROM TESTRUN,TESTCPU,TESTOS,TESTVERSION '+
-                'WHERE '+
-                ' (TC_ID=TU_CPU_FK) AND '+
-                ' (TO_ID=TU_OS_FK) AND '+
-                ' (TV_ID=TU_VERSION_FK) AND '+
-                ' (TU_ID=%s)';
-
-
-Var
-  Q1, Q2 : TSQLQuery;
-  F : TField;
-  SC, FRight : string;
-  Date1, Date2 : TDateTime;
-  AddNewPar, same_date : boolean;
-  CompilerDate1, CompilerDate2 : TDateTime;
-
-  procedure EmitOneRow(RowTitle,FieldLeft,FieldRight : String; is_same : boolean);
-    var
-      FieldColor : string;
-    begin
-      if (FieldRight='') then
-        FieldColor:=''
-      else if is_same then
-        FieldColor:='style="color:green;"'
-      else
-        FieldColor:='style="color:red;"';
-      With FHTMLWriter do
-        begin
-          RowNext;
-          if FieldColor<>'' then
-            begin
-              TagStart('TD',FieldColor);
-            end
-          else 
-            CellStart;
-          LDumpLn(RowTitle);
-          if FieldColor<>'' then
-            begin
-              CellEnd;
-              TagStart('TD',FieldColor);
-            end
-          else 
-            CellNext;
-          LDumpLn(FieldLeft);
-          if FieldColor<>'' then
-            begin
-             CellEnd;
-             TagStart('TD',FieldColor);
-            end
-          else 
-            CellNext;
-          LDumpLn(FieldRight);
-          CellEnd;
-        end;
-    end;
-  procedure EmitOneRow(RowTitle,FieldLeft,FieldRight : String);
-    var
-      is_same : boolean;
-    begin
-      is_same:=(FieldLeft=FieldRight);
-      EmitOneRow(RowTitle,FieldLeft,FieldRight,is_same);
-    end;
-  procedure EmitRow(RowTitle,FieldName : String);
-    var
-      FieldLeft, FieldRight : String;
-    begin
-      FieldLeft:=Q1.FieldByName(FieldName).AsString;
-      if Q2=nil then
-        FieldRight:=''
-      else
-        FieldRight:=Q2.FieldByName(FieldName).AsString;
-      EmitOneRow(RowTitle,FieldLeft,FieldRight);
-    end;
-begin
-  Result:=(FRunID<>'');
-  If Result then
-    begin
-    If GetCategoryName(FCategory)<>'DB' then
-      SC:=', CONCAT(TU_SVNCOMPILERREVISION,''/'',TU_SVNRTLREVISION,''/'', '+
-          'TU_SVNPACKAGESREVISION,''/'',TU_SVNTESTSREVISION) as svnrev'
-    else
-      SC:='';
-    If GetCategoryName(FCategory)='All' then
-      SC:=SC+', TCAT_NAME as Cat';
-
-    Q1:=CreateDataset(Format(SGetRunData,[SC,FRunID]));
-    if Length(FCompareRunID) > 0 then
-      Q2:=CreateDataset(Format(SGetRunData,[SC,FCompareRunID]))
-    else
-      Q2:=nil;
-    Try
-      Q1.Open;
-      if Q2 <> nil then
-        Q2.Open;
-      Result:=Not (Q1.EOF and Q1.BOF);
-      If Result then
-       With FHTMLWriter do
-        begin
-          FormStart(TestsuiteCGIURL,'get');
-          TableStart(3,true);
-          RowStart;
-            CellStart;
-              DumpLn('Run ID:');
-            CellNext;
-              EmitInput('run1id',FRunID);
-            CellNext;
-              EmitInput('run2id',FCompareRunID);
-            CellEnd;
-
-          EmitRow('Operating system:','TO_NAME');
-          EmitRow('Processor:','TC_NAME');
-          EmitRow('Version:','TV_VERSION');
-          if Q2 = nil then
-            FRight:=''
-          else
-            begin
-              FRight:=Q2.FieldByName('Failed').AsString+
-                      '/'+Q2.FieldByName('Ok').AsString+
-                      '/'+Q2.FieldByName('Total').AsString;
-            end;
-          EmitOneRow('Fails/OK/Total:',
-            Q1.FieldByName('Failed').AsString+
-            '/'+Q1.FieldByName('OK').AsString+
-            '/'+Q1.FieldByName('Total').AsString,
-            FRight);
-          EmitRow('Version:','TV_VERSION');
-          EmitRow('Full version:','TU_COMPILERFULLVERSION');
-          EmitRow('Comment:','TU_COMMENT');
-          EmitRow('Machine:','TU_MACHINE');
-          if GetCategoryName(FCategory)<>'All' then
-            EmitRow('Category:','TU_CATEGORY_FK');
-          If GetCategoryName(FCategory)<>'DB' then
-            begin
-              SC:=Q1.FieldByName('svnrev').AsString;
-              if (SC<>'') then
-                FormatSVNData(SC);
-              if Q2 <> nil then
-                begin
-                  FRight:=Q2.FieldByName('svnrev').AsString;
-                  FormatSVNData(FRight);
-                end
-              else
-                FRight:='';
-              EmitOneRow('SVN revisions:',SC,FRight);
-            end;
-          EmitRow('Submitter:','TU_SUBMITTER');
-          F := Q1.FieldByName('TU_DATE');
-          Date1 := F.AsDateTime;
-          SC:=F.AsString;
-          F := Q1.FieldByName('TU_COMPILERDATE');
-          Try
-            CompilerDate1 := F.AsDateTime;
-            if not SameDate(Date1,CompilerDate1) then
-              SC:=SC+' <> '+F.AsString;
-          Except
-            { Not a valid date, do nothing }
-          end;
-          if Q2 = nil then
-            FRight:=''
-          else
-            begin
-              F := Q2.FieldByName('TU_DATE');
-              Date2 := F.AsDateTime;
-              FRight:= F.AsString;
-              F := Q2.FieldByName('TU_COMPILERDATE');
-              Try
-                CompilerDate2 := F.AsDateTime;
-                if not SameDate(Date2,CompilerDate2) then
-                  FRight:=FRight+' <> '+F.AsString;
-              Except
-                { Not a valid date, do nothing }
-              end;
-            end;
-          same_date:=(Copy(SC,1,10)=Copy(FRight,1,10));
-          EmitOneRow('Date:',SC,FRight,same_date); 
-          FPreviousRunID:=GetPreviousRunID(FRunID);
-          if FPreviousRunID<>'' then
-            EmitHiddenVar('previousrunid',FPreviousRunID);
-          SC:=FPreviousRunID;
-          if (FCompareRunID<>'') then
-            begin
-              FPrevious2RunID:=GetPreviousRunID(FCompareRunID);
-              FRight:=FPrevious2RunID;
-              if FPrevious2RunID <> '' then
-                EmitHiddenVar('previous2runid',FPrevious2RunID);
-            end
-          else
-            FRight:='';
-          EmitOneRow('Previous run:',SC,FRight);
-          FNextRunID:=GetNextRunID(FRunID);
-          if FNextRunID<>'' then
-            EmitHiddenVar('nextrunid',FNextRunID);
-          SC:=FNextRunID;
-          if (FCompareRunID<>'') then
-            begin
-              FNext2RunID:=GetNextRunID(FCompareRunID);
-              FRight:=FNext2RunID;
-              if FNext2RunID <> '' then
-                EmitHiddenVar('next2runid',FNext2RunID);
-            end;
-          EmitOneRow('Next run:',SC,FRight);
-          RowEnd;
-          TableEnd;
-          ParagraphStart;
-          if FDebug then
-            EmitHiddenVar('DEBUGCGI', '1');
-          EmitCheckBox('noskipped','1',FNoSkipped);
-          DumpLn(' Hide skipped tests');
-	  ParagraphEnd;
-	  ParagraphStart;
-          EmitCheckBox('failedonly','1',FonlyFailed);
-          DumpLn(' Hide successful tests');
-          ParagraphEnd;
-          ParaGraphStart;
-          AddNewPar:=false;
-          if FPreviousRunID<>'' then
-            begin
-              EmitSubmitButton('action','Compare_to_previous');
-              AddNewPar:=true;
-            end;
-          if (FNextRunID<>'') and (FNextRunID <> FCompareRunID) then
-            begin
-              EmitSubmitButton('action','Compare_to_next');
-              AddNewPar:=true;
-            end;
-          if (FPrevious2RunID<>'') and (FPrevious2RunID <> FRunID) then
-            begin
-              EmitSubmitButton('action','Compare_right_to_previous');
-              AddNewPar:=true;
-            end;
-          if FNext2RunID<>'' then
-            begin
-              EmitSubmitButton('action','Compare_right_to_next');
-              AddNewPar:=true;
-            end;
-          if AddNewPar then
-            begin
-              ParagraphEnd;
-              ParaGraphStart;
-            end;
-              
-          if (FPrevious2RunID<>'') and (FPreviousRunId<>'') then
-            begin
-              EmitSubmitButton('action','Compare_both_to_previous');
-              AddNewPar:=true;
-            end;
-          if (FNext2RunID<>'') and (FNextRunId<>'') then
-            begin
-              EmitSubmitButton('action','Compare_both_to_next');
-              AddNewPar:=true;
-            end;
-          if AddNewPar then
-            begin
-              ParagraphEnd;
-              ParaGraphStart;
-            end;
-           EmitSubmitButton('action','Show/Compare');
-          if FTestFileID<>'' then
-            EmitSubmitButton('action','View_history');
-          EmitResetButton('','Reset form');
-          ParagraphEnd;
-          FormEnd;
-          { give warning if dates reversed }
-          if (Q2 <> nil) and (Date1 > Date2) then
-            begin
-            ParagraphStart;
-            DumpLn('Warning: testruns are not compared in chronological order.');
-            ParagraphEnd;
-            end;
-          end;
-    Finally
-      Q1.Close;
-      Q1.Free;
-      if Q2 <> nil then
-        begin
-        Q2.Close;
-        Q2.Free;
-        end;
-    end;
-    end;
-end;
-
-Procedure TTestSuite.ShowRunResults;
-
-Var
-  S : String;
-  Qry : String;
-  Q : TSQLQuery;
-  FL : String;
-
-begin
-  ConnectToDB;
-  ContentType:='text/html';
-  EmitContentType;
-  EmitDocType;
-  EmitTitle(Title+' : Search Results');
-  With FHTMLWriter do
-    begin
-    HeaderStart(1);
-    DumpLn('Test suite results for run '+FRunID);
-    HeaderEnd(1);
-    HeaderStart(2);
-    DumpLn('Test run data : ');
-    HeaderEnd(2);
-    If ShowRunData then
-      begin
-      HeaderStart(2);
-      DumpLn('Detailed test run results:');
-
-      FL:='';
-      If FOnlyFailed or FNoSkipped then
-        begin
-        FL:='';
-        If FOnlyFailed then
-          FL:='successful';
-        if FNoSkipped then
-          begin
-          If (FL<>'') then
-            FL:=FL+' and ';
-          FL:=FL+'skipped';
-          end;
-        DumpLn(' ('+FL+' tests are hidden)');
-        end;
-      HeaderEnd(2);
-      S:='SELECT T_ID as Id,T_NAME as Filename,TR_SKIP as Skipped'
-        +',TR_OK as OK,TR_RESULT as Result'
-        +' FROM '+TESTRESULTSTableName(FRunID)+',TESTS'
-        +' WHERE (TR_TEST_FK=T_ID) AND (TR_TESTRUN_FK='+FRunID+') ';
-
-      If FOnlyFailed then
-        S:=S+' AND (not TR_OK)';
-      If FNoSkipped then
-        S:=S+' AND (not TR_SKIP)';
-      S:=S+' ORDER BY TR_ID ';
-      Qry:=S;
-      If FDebug then
-        begin
-        ParaGraphStart;
-        Dumpln('Query : '+Qry);
-        ParaGraphEnd;
-      end;
-      FRunCount:=0;
-      FRunSkipCount:=0;
-      FRunFailedCount:=0;
-      Q:=CreateDataset(Qry);
-      With Q do
-        try
-          Open;
-          while not EOF do
-            Next;
-          RecNo:=1;
-
-          DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
-          Try
-            With CreateTableProducer(Q) do
-              Try
-                Border:=True;
-                FL:='Id,Filename';
-                If Not FNoSkipped then
-                  FL:=FL+',Skipped';
-                If Not FOnlyFailed then
-                  FL:=FL+',OK';
-                FL:=FL+',Result';
-                CreateColumns(FL);
-                OnGetRowAttributes:=@GetRunRowAttr;
-                TableColumns.ColumnByNAme('Id').OnGetCellContents:=
-                  @FormatFileIDDetails;
-
-                TableColumns.ColumnByNAme('Filename').OnGetCellContents:=
-                  @FormatFileDetails;
-                TableColumns.ColumnByNAme('Result').OnGetCellContents:=
-                  @FormatTestResult;
-                //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
-                CreateTable(Response);
-              Finally
-                Free;
-              end;
-          Finally
-            Close;
-          end;
-        finally
-          Free;
-        end;
-      If Not (FRunCount=0) and not (FNoSkipped and FOnlyFailed) then
-        begin
-        ParaGraphStart;
-        TagStart('IMG',Format('Src="'+TestsuiteCGIURL+
-        '?action=2&amp;pietotal=%d&amp;piefailed=%d&amp;pieskipped=%d"'+
-        ' ALT="total=%d, failed=%d, skipped=%d"',
-        [FRunCount,FRunFailedCount,FRunSkipCount,
-          FRunCount,FRunFailedCount,FRunSkipCount
-          ]));
-        end;
-      end
-    else
-      DumpLn('No data for test run with ID: '+FRunID);
-    end;
-end;
-
-Procedure TTestSuite.DumpTestInfo(Q : TSQLQuery);
-
-Var
-  I : Integer;
-  field_displayed : boolean;
-  FieldValue,FieldName : String;
-
-begin
-  With FHTMLWriter do
-    For i:=0 to Q.FieldCount-1 do
-      begin
-      FieldValue:=Q.Fields[i].AsString;
-      FieldName:=Q.Fields[i].DisplayName;
-      field_displayed:=false;
-      if (Not Q.fields[i].IsNull) and (FieldName<>'t_name') and (FieldName<>'t_source') then
-        begin
-        if (Q.Fields[i].Datatype=ftBoolean) then
-          begin
-            if Q.Fields[i].AsBoolean then
-              begin
-                DumpLn('Flag ');
-                DumpLn(FieldName);
-                DumpLn(' set');
-                field_displayed:=true;
-              end;
-          end
-        else if FieldValue<>'' then
-          begin
-            DumpLn(FieldName);
-            DumpLn(' ');
-            DumpLn(FieldValue);
-            field_displayed:=true;
-          end;
-        if field_displayed then
-          DumpLn('<BR>');
-        end;
-      end;
-end;
-
-Procedure TTestSuite.ShowOneTest;
-
-Var
-  S,S2 : String;
-  Qry : String;
-  Base, Category : string;
-  Q : TSQLQuery;
-  i,index : longint;
-  FieldName,FieldValue,
-  LLog,Source : String;
-  Res : Boolean;
-  ver : known_versions;
-begin
-  ConnectToDB;
-  ContentType:='text/html';
-  EmitContentType;
-  EmitDocType;
-  if FTestFileID='' then
-    FTestFileID:=GetSingleton('SELECT T_ID FROM TESTS WHERE T_NAME LIKE ''%'+FTestFileName+'%''');
-  if FTestFileID<>'' then
-    FTestFileName:=GetTestFileName(FTestFileID);
-  EmitTitle(Title+' : File '+FTestFileName+' Results');
-  With FHTMLWriter do
-    begin
-    HeaderStart(1);
-    DumpLn('Test suite results for test file '+FTestFileName);
-    HeaderEnd(1);
-    HeaderStart(2);
-    DumpLn('Test run data : ');
-    HeaderEnd(2);
-    if FRunID<>'' then
-      begin
-        Res:=ShowRunData;
-        Res:=true;
-      end
-    else
-      begin
-        // This is useless as it is now
-        // It should be integrated into a form probably PM
-        DumpLn('Only failed tests');
-        EmitCheckBox('failedonly','1',FonlyFailed);
-        DumpLn('Hide skipped tests');
-        EmitCheckBox('noskipped','1',FNoSkipped);
-        Res:=true;
-      end;
-    If Res then
-      begin
-      HeaderStart(2);
-      DumpLn('Test file "'+FTestFileName+'" information:');
-      HeaderEnd(2);
-      ParaGraphStart;
-      if FTestFileID<>'' then
-        S:='SELECT * FROM TESTS WHERE T_ID='+FTestFileID
-      else
-        S:='SELECT * FROM TESTS WHERE T_NAME='+FTestFileName;
-      Q:=CreateDataSet(S);
-      With Q do
-        Try
-          Open;
-          Try
-            DumpTestInfo(Q);
-          Finally
-            Close;
-          end;
-        Finally
-          Free;
-        end;
-      ParaGraphEnd;
-      HeaderStart(2);
-      DumpLn('Detailed test run results:');
-
-      HeaderEnd(2);
-      S:='SELECT TR_ID,TR_TESTRUN_FK AS RUN,TR_TEST_FK,TR_OK, TR_SKIP,TR_RESULT '
-      //S:='SELECT * '
-        +' FROM '+TESTRESULTSTableName(FRunID)
-        +' WHERE  (TR_TEST_FK='+FTestFileID+')';
-      If FOnlyFailed then
-        S:=S+' AND (TR_OK="-")';
-      if Fcomparerunid<>'' then
-        begin
-          if TESTRESULTSTableName(FRunID)<>TESTRESULTSTableName(FCompareRunID) then
-            begin
-              S2:='SELECT TR_ID,TR_TESTRUN_FK AS RUN,TR_TEST_FK,TR_OK, TR_SKIP,TR_RESULT '
-                  +' FROM '+TESTRESULTSTableName(FCompareRunID)
-                  +' WHERE  (TR_TEST_FK='+FTestFileID+')';
-              If FOnlyFailed then
-                S2:=S2+' AND (TR_OK="-")';
-
-              S:=S+' AND (TR_TESTRUN_FK='+Frunid+') UNION '+
-                 S2+' AND (TR_TESTRUN_FK='+Fcomparerunid+')'
-            end
-          else
-            S:=S+' AND ((TR_TESTRUN_FK='+Frunid+') OR '+
-                 '(TR_TESTRUN_FK='+Fcomparerunid+'))'
-        end
-      else if Frunid<>'' then
-        S:=S+' AND (TR_TESTRUN_FK='+Frunid+')'
-      else
-         S:=S+' ORDER BY TR_TESTRUN_FK DESC LIMIT '+IntToStr(FLimit);
-      Qry:=S;
-      If FDebug then
-      begin
-        ParaGraphStart;
-        Dumpln('Query : '+Qry);
-        ParaGraphEnd;
-      end;
-      FRunCount:=0;
-      FRunSkipCount:=0;
-      FRunFailedCount:=0;
-      Q:=CreateDataset(Qry);
-      With Q do
-        try
-          Open;
-          Try
-            With CreateTableProducer(Q) do
-              Try
-                Border:=True;
-                //FL:='TR_ID,TR_TESTRUN_FK,T_NAME,T_CPU,T_VERSION';
-                CreateColumns(Nil);
-                TableColumns.Delete(TableColumns.ColumnByName('TR_TEST_FK').Index);
-                TableColumns.ColumnByNAme('RUN').OnGetCellContents:=
-                  @FormatTestRunOverview;
-                //OnGetRowAttributes:=@GetRunRowAttr;
-                TableColumns.ColumnByNAme('TR_RESULT').OnGetCellContents:=
-                  @FormatTestResult;
-                //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
-                CreateTable(Response);
-              Finally
-                Free;
-              end;
-           ParaGraphStart;
-           DumpLn(Format('Record count: %d',[Q.RecordCount]));
-           ParaGraphEnd;
-          Finally
-            Close;
-          end;
-        finally
-          Free;
-        end;
-             //If FDebug then
-            Category:='1';
-            if FRunId<>'' then
-              begin
-                Category:=getsingleton('select TU_CATEGORY_FK from TESTRUN where TU_ID='+FRunId);
-                FVersionBranch:=GetVersionName(getsingleton('select TU_VERSION_FK from TESTRUN where TU_ID='+fRunId));
-                LLog:='';
-                Try
-                LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
-                     +') and (TR_TESTRUN_FK='+frunid+')');
-                if LLog<>'' then
-                  begin
-                    HeaderStart(2);
-                    DumpLn('Log of '+FRunId+':');
-                    HeaderEnd(2);
-                    PreformatStart;
-                    system.Write(LLog);
-                    system.flush(output);
-                    PreformatEnd;
-                  end;
-                Finally
-                  if LLog='' then
-                    begin
-                      HeaderStart(2);
-                      DumpLn('No log of '+FRunId+'.');
-                      HeaderEnd(2);
-                    end;
-                end;
-              end;
-            if FCompareRunId<>'' then
-              begin
-                LLog:='';
-                Try
-                LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
-                     +') and (TR_TESTRUN_FK='+fcomparerunid+')');
-                if LLog<>'' then
-                  begin
-                    HeaderStart(2);
-                    DumpLn('Log of '+FCompareRunId+':');
-                    HeaderEnd(2);
-                    PreformatStart;
-                    system.Write(LLog);
-                    system.flush(output);
-                    PreformatEnd;
-                  end;
-                Finally
-                  if LLog='' then
-                    begin
-                      HeaderStart(2);
-                      DumpLn('No log of '+FCompareRunId+'.');
-                      HeaderEnd(2);
-                    end;
-                end;
-              end;
-            if FDebug then
-              DumpLn('After Log.');
-            Source:='';
-            Try
-            Source:=getsingleton('select T_SOURCE from TESTS where T_ID='+ftestfileid);
-            if Source<>'' then
-              begin
-                HeaderStart(2);
-                DumpLn('Source:');
-                HeaderEnd(2);
-                PreformatStart;
-                system.Write(Source);
-                system.flush(output);
-                PreformatEnd;
-              end;
-            Finally
-            Base:='trunk';
-            if  FVersionBranch<>'' then
-              begin
-                // Test all but last version, which is assumed to be trunk
-                for ver:=low(known_versions) to pred(high(known_versions)) do
-                  if VER_String[ver]=FVersionBranch then
-                    begin
-                      base:=ver_branch[ver];
-                      break;
-                    end;
-              end;
-            if UseGit then
-              begin
-                index:=pos('/',Base);
-                if index>0 then
-                  Base:=Copy(Base,index+1,length(Base));
-                if Base='trunk' then
-                  Base:='main';
-                FViewVCURL:=ViewGitHashURL+Base;
-              end
-            else
-              FViewVCURL:=ViewURL+Base;
-            if Category='1' then
-              FViewVCUrl:=FViewVCURL+TestsSubDir
-            else
-              begin
-                FViewVCUrl:=FViewVCURL+DataBaseSubDir;
-                // This assumes that type TAnyType is
-                // defined in anytype.pas source PM
-                if pos('/',FTestFileName)>0 then
-                  FTestfilename:=lowercase(copy(FTestFilename,2,pos('/',FTestFilename)-2)+'.pas');
-              end;
-            if Source='' then
-              begin
-                HeaderStart(3);
-                DumpLn('<P>No Source in TestSuite DataBase.</P>');
-                DumpLn('Link to SVN view of '+
-                  '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
-                  '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
-                HeaderEnd(3);
-              end
-            else
-              begin
-                HeaderStart(3);
-                DumpLn('Link to SVN view of '+
-                  '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
-                  '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
-                HeaderEnd(3);
-              end;
-            end;
-             if FDebug then
-              DumpLn('After Source.');
-    end
-    else
-      DumpLn(Format('No data for test file with ID: %s',[FTestFileID]));
-
-    end;
-end;
-
-
-Procedure TTestSuite.ShowHistory;
-
-Const
-  { We already have 53 versions }
-  MaxCombo = 100;
-
-Type
-  StatusLongintArray = Array [TTestStatus] of longint;
-  StatusDateTimeArray = Array [TTestStatus] of TDateTime;
-  AStatusLA = Array[1..MaxCombo] of StatusLongintArray;
-  AStatusDTA = Array[1..MaxCombo] of StatusDateTimeArray;
-  PStatusLA = ^AStatusLA;
-  PStatusDTA = ^AStatusDTA;
-
-Var
-  S,SS,FL,cpu,version,os : String;
-  date : TDateTime;
-  Qry : String;
-  Base, Category : string;
-  Q : TSQLQuery;
-  i,index,run_id,os_id,version_id,cpu_id : longint;
-  run_ind,os_ind,version_ind,cpu_ind,
-  ok_ind,skip_ind,result_ind,date_ind : longint;
-  os_size, cpu_size, version_size : longint;
-  os_last, cpu_last, version_last : longint;
-  error : word;
-  OK_count, not_OK_count,resi,
-  total_count, skip_count, not_skip_count : longint;
-  TS : TTestStatus;
-  result_count : StatusLongintArray;
-  os_count,cpu_count,version_count: PStatusLA;
-  first_date, last_date : array[TTestStatus] of TDateTime;
-  first_date_id, last_date_id : array[TTestStatus] of longint;
-  os_first_date, os_last_date,
-  cpu_first_date, cpu_last_date,
-  version_first_date, version_last_date : PStatusDTA;
-  os_first_date_id, os_last_date_id,
-  cpu_first_date_id, cpu_last_date_id,
-  version_first_date_id, version_last_date_id : PStatusLA;
-  FieldName,FieldValue,
-  LLog,Source : String;
-  B,Res : Boolean;
-  ver : known_versions;
-
-begin
-  Res:=False;
-  os_count:=nil;
-  cpu_count:=nil;
-  version_count:=nil;
-  ConnectToDB;
-  ContentType:='text/html';
-  EmitContentType;
-  EmitDocType;
-  if (FTestFileID='') and (FTestFileName<>'') then
-  begin
-    FTestFileID:=GetSingleton('SELECT T_ID FROM TESTS WHERE T_NAME LIKE ''%'+
-     FTestFileName+'%''');
-  end;
-  if FTestFileID<>'' then
-    FTestFileName:=GetTestFileName(FTestFileID);
-  if FTestFileName<>'' then
-    EmitTitle(Title+' : File '+FTestFileName+' Results')
-  else
-    EmitTitle(Title+' : History overview');
-  With FHTMLWriter do
-    begin
-    if FTestFileName<>'' then
-      begin
-        HeaderStart(1);
-        DumpLn('Test suite results for test file '+FTestFileName);
-        HeaderEnd(1);
-        HeaderStart(2);
-        DumpLn('Test run data : ');
-        HeaderEnd(2);
-      end;
-    if FRunID<>'' then
-      begin
-        Res:=ShowRunData;
-        Res:=true;
-      end
-    else
-      begin
-        // This is useless as it is now
-        // It should be integrated into a form probably PM
-        //DumpLn('Only failed tests');
-        //EmitCheckBox('failedonly','1',FonlyFailed);
-        //DumpLn('Hide skipped tests');
-        //EmitCheckBox('noskipped','1',FNoSkipped);
-        Res:=true;
-        EmitHistoryForm;
-        if FTestFileID = '' then
-          with FHTMLWriter do begin
-            HeaderStart(2);
-            if Trim(FTestFileName) <> '' then
-              DumpLn(Format('Error: No test files matching "%s" found.', [FTestFileName]))
-            else
-              DumpLn('Error: Please specify a test file.');
-            HeaderEnd(2);
-            Res:=False;
-          end;
-      end;
-    If Res then
-      begin
-        if (FTestFileName<>'') then
-          begin
-          HeaderStart(2);
-          DumpLn('Test file "'+FTestFileName+'" information:');
-          HeaderEnd(2);
-          ParaGraphStart;
-          S:='SELECT * FROM TESTS WHERE T_ID='+FTestFileID;
-          Q:=CreateDataSet(S);
-          With Q do
-            Try
-              Open;
-              Try
-                DumpTestInfo(Q);
-              Finally
-                Close;
-              end;
-            Finally
-              Free;
-            end;
-          ParaGraphEnd;
-          HeaderStart(2);
-          DumpLn('Detailed test run results:');
-        end;
-      HeaderEnd(2);
-      ParaGraphStart;
-      SS:='SELECT TR_ID,TR_TESTRUN_FK AS Run,TR_TEST_FK,TR_OK AS OK'
-        +', TR_SKIP As Skip,TR_RESULT  As Result'
-      //S:='SELECT * '
-        +',TC_NAME AS CPU, TV_VERSION AS Version, TO_NAME AS OS'
-        +',TU_ID,TU_DATE AS Date,TU_SUBMITTER  AS Submitter'
-        +',(TU_FAILEDTOCOMPILE + TU_FAILEDTOFAIL + TU_FAILEDTORUN) AS Fails'
-        +',TU_MACHINE AS Machine,TU_COMMENT AS Comment'
-        +',TU_COMPILERDATE As CompDate'
-        +',TU_SVNTESTSREVISION AS Tests_rev'
-        +',TU_SVNRTLREVISION AS RTL_rev'
-        +',TU_SVNCOMPILERREVISION AS Compiler_rev'
-        +',TU_SVNPACKAGESREVISION AS Packages_rev'
-        +',TO_ID,TC_ID,TV_ID'
-        +' FROM TESTRUN '
-        +' LEFT JOIN TESTRESULTS ON  (TR_TESTRUN_FK=TU_ID)'
-        +' LEFT JOIN TESTOS ON  (TU_OS_FK=TO_ID)'
-        +' LEFT JOIN TESTCPU ON  (TU_CPU_FK=TC_ID)'
-        +' LEFT JOIN TESTVERSION ON  (TU_VERSION_FK=TV_ID)';
-      S:='';
-      if FTestFileID<>'' then
-        S:=S+' AND (TR_TEST_FK='+FTestFileID+')';
-      if FRunID<>'' then
-        S:=S+' AND (TR_TESTRUN_FK='+FRunID+')';
-      If FOnlyFailed then
-        S:=S+' AND (NOT TR_OK)';
-      If FNoSkipped then
-        S:=S+' AND (NOT TR_SKIP)';
-      If FCond<>'' then
-        S:=S+' AND ('+FCond+')';
-
-      If (FCPU<>'') and (GetCPUName(FCPU)<>'All') then
-        begin
-          S:=S+' AND (TU_CPU_FK='+FCPU+')';
-          cpu_size:=0;
-        end
-      else
-        begin
-          cpu_last:=StrToInt(GetSingleton('SELECT MAX(TC_ID) FROM TESTCPU'));
-          cpu_size:=Sizeof(StatusLongintArray)*(1+cpu_last);
-          cpu_count:=GetMem(cpu_size);
-          FillChar(cpu_count^,cpu_size,#0);
-          cpu_first_date_id:=GetMem(cpu_size);
-          FillChar(cpu_first_date_id^,cpu_size,#0);
-          cpu_last_date_id:=GetMem(cpu_size);
-          FillChar(cpu_last_date_id^,cpu_size,#0);
-          cpu_first_date:=GetMem(cpu_last*SizeOf(StatusDateTimeArray));
-          FillChar(cpu_first_date^,cpu_last*Sizeof(StatusDateTimeArray),#0);
-          cpu_last_date:=GetMem(cpu_last*SizeOf(StatusDateTimeArray));
-          FillChar(cpu_last_date^,cpu_last*Sizeof(StatusDateTimeArray),#0);
-        end;
-      If (FVersion<>'') and (GetVersionName(FVersion)<>'All')  then
-        begin
-          S:=S+' AND (TU_VERSION_FK='+FVERSION+')';
-          version_size:=0;
-        end
-      else
-        begin
-          version_last:=StrToInt(GetSingleton('SELECT MAX(TV_ID) FROM TESTVERSION'));
-          version_size:=Sizeof(StatusLongintArray)*(1+version_last);
-          version_count:=GetMem(version_size);
-          FillChar(version_count^,version_size,#0);
-          version_first_date_id:=GetMem(version_size);
-          FillChar(version_first_date_id^,version_size,#0);
-          version_last_date_id:=GetMem(version_size);
-          FillChar(version_last_date_id^,version_size,#0);
-          version_first_date:=GetMem(version_last*SizeOf(StatusDateTimeArray));
-          FillChar(version_first_date^,version_last*Sizeof(StatusDateTimeArray),#0);
-          version_last_date:=GetMem(version_last*SizeOf(StatusDateTimeArray));
-          FillChar(version_last_date^,version_last*Sizeof(StatusDateTimeArray),#0);
-
-        end;
-
-      if (FOS<>'') and (GetOSName(FOS)<>'All') then
-        begin
-          S:=S+' AND (TU_OS_FK='+FOS+')';
-          os_size:=0;
-        end
-      else
-        begin
-          os_last:=StrToInt(GetSingleton('SELECT MAX(TO_ID) FROM TESTOS'));
-          os_size:=Sizeof(StatusLongintArray)*(1+os_last);
-          os_count:=GetMem(os_size);
-          FillChar(os_count^,os_size,#0);
-          os_first_date_id:=GetMem(os_size);
-          FillChar(os_first_date_id^,os_size,#0);
-          os_last_date_id:=GetMem(os_size);
-          FillChar(os_last_date_id^,os_size,#0);
-          os_first_date:=GetMem(os_last*SizeOf(StatusDateTimeArray));
-          FillChar(os_first_date^,os_last*Sizeof(StatusDateTimeArray),#0);
-          os_last_date:=GetMem(os_last*SizeOf(StatusDateTimeArray));
-          FillChar(os_last_date^,os_last*Sizeof(StatusDateTimeArray),#0);
-        end;
-
-      If FSubmitter<>'' then
-        S:=S+' AND (TU_SUBMITTER='''+FSubmitter+''')';
-      If FMachine<>'' then
-        S:=S+' AND (TU_MACHINE='''+FMachine+''')';
-      If FComment<>'' then
-        S:=S+' AND (TU_COMMENT LIKE '''+FComment+''')';
-      if FDATE<>0 then
-        S:=S+' AND (TU_DATE >= '''+FormatDateTime('YYYY-MM-DD',FDate)+''')';
-
-      if S <> '' then
-      begin
-        Delete(S, 1, 4);
-        S:=SS + ' WHERE '+ S;
-      end
-      else
-        S:=SS;
-
-      S:=S+' ORDER BY TU_ID DESC';
-      if FDATE=0 then
-        S:=S+' LIMIT '+IntToStr(FLimit)
-      else
-        S:=S+' LIMIT '+IntToStr(MaxLimit);
-      Qry:=S;
-      If FDebug then
-      begin
-        Writeln(system.stdout,'Query : '+Qry);
-        system.Flush(system.stdout);
-      end;
-      FRunCount:=0;
-      FRunSkipCount:=0;
-      FRunFailedCount:=0;
-      Q:=CreateDataset(Qry);
-      With Q do
-        try
-          Open;
-
-          while not EOF do
-            Next;
-
-          DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
-          if RecordCount>0 then
-            RecNo:=1;
-
-          Try
-           { if FDebug then
-             begin
-               Writeln(stdout,'FieldKind=',Fields[0].FieldKind);
-               Writeln(stdout,'DataType=',Fields[0].DataType);
-               system.flush(stdout);
-             end; }
-
-          total_count:=0;
-          OK_count:=0;
-          not_OK_count:=0;
-          skip_count:=0;
-          not_skip_count:=0;
-          fillchar(Result_Count,Sizeof(Result_count),#0);
-          ok_ind:=FieldByName('OK').Index;
-          skip_ind:=FieldBYName('SKIP').Index;
-          result_ind:=FieldByName('Result').Index;
-          cpu_ind:=FieldByName('TC_ID').Index;
-          os_ind:=FieldByName('TO_ID').Index;
-          version_ind:=FieldByName('TV_ID').Index;
-          date_ind:=FieldByName('Date').Index;
-          run_ind:=FieldByName('TU_ID').Index;
-          For i:=1 to Q.RecordCount do
-            begin
-              Q.RecNo:=i;
-              inc(total_count);
-              if Q.Fields[ok_ind].AsBoolean then
-                inc(OK_count)
-              else
-                inc(not_OK_count);
-              if Fields[skip_ind].AsBoolean then
-                inc(skip_count)
-              else
-                inc(not_skip_count);
-              S:=Fields[result_ind].AsString;
-              cpu:=Fields[cpu_ind].ASString;
-              version:=Fields[version_ind].AsString;
-              os:=Fields[os_ind].AsString;
-              date:=Fields[date_ind].ASDateTime;
-              os_id:=Fields[os_ind].AsLongint;
-              cpu_id:=Fields[cpu_ind].AsLongint;
-              version_id:=Fields[version_ind].AsLongint;
-              system.val(S,resi,error);
-              run_id:=Fields[run_ind].ASLongint;
-              if (error=0) and (Resi>=longint(FirstStatus)) and
-                 (Resi<=longint(LastStatus)) then
-                begin
-                  TS:=TTestStatus(Resi);
-                  if Result_count[TS]=0 then
-                    begin
-                      first_date[TS]:=date;
-                      last_date[TS]:=date;
-                      first_date_id[TS]:=run_id;
-                      last_date_id[TS]:=run_id;
-                    end
-                  else
-                    begin
-                      if (date>last_date[TS]) then
-                        begin
-                          last_date[TS]:=date;
-                          last_date_id[TS]:=run_id;
-                        end;
-                      if date<first_date[TS] then
-                        begin
-                          first_date[TS]:=date;
-                          first_date_id[TS]:=run_id;
-                        end;
-                    end;
-
-                  inc(Result_count[TS]);
-                  if assigned(cpu_count) and (cpu_id<=cpu_last) then
-                    begin
-                      if cpu_count^[cpu_id,TS]=0 then
-                        begin
-                          cpu_first_date^[cpu_id,TS]:=date;
-                          cpu_last_date^[cpu_id,TS]:=date;
-                          cpu_first_date_id^[cpu_id,TS]:=run_id;
-                          cpu_last_date_id^[cpu_id,TS]:=run_id;
-                        end
-                      else
-                        begin
-                          if (date>cpu_last_date^[cpu_id,TS]) then
-                            begin
-                              cpu_last_date^[cpu_id,TS]:=date;
-                              cpu_last_date_id^[cpu_id,TS]:=run_id;
-                            end;
-                          if date<cpu_first_date^[cpu_id,TS] then
-                            begin
-                              cpu_first_date^[cpu_id,TS]:=date;
-                              cpu_first_date_id^[cpu_id,TS]:=run_id;
-                            end;
-                        end;
-                      inc(cpu_count^[cpu_id,TS]);
-                    end;
-                  if assigned(os_count) and (os_id<=os_last) then
-                    begin
-                      if os_count^[os_id,TS]=0 then
-                        begin
-                          os_first_date^[os_id,TS]:=date;
-                          os_last_date^[os_id,TS]:=date;
-                          os_first_date_id^[os_id,TS]:=run_id;
-                          os_last_date_id^[os_id,TS]:=run_id;
-                        end
-                      else
-                        begin
-                          if (date>os_last_date^[os_id,TS]) then
-                            begin
-                              os_last_date^[os_id,TS]:=date;
-                              os_last_date_id^[os_id,TS]:=run_id;
-                            end;
-                          if date<os_first_date^[os_id,TS] then
-                            begin
-                              os_first_date^[os_id,TS]:=date;
-                              os_first_date_id^[os_id,TS]:=run_id;
-                            end;
-                        end;
-                      inc(os_count^[os_id,TS]);
-                    end;
-                  if assigned(version_count) and (version_id<=version_last) then
-                    begin
-                      if version_count^[version_id,TS]=0 then
-                        begin
-                          version_first_date^[version_id,TS]:=date;
-                          version_last_date^[version_id,TS]:=date;
-                          version_first_date_id^[version_id,TS]:=run_id;
-                          version_last_date_id^[version_id,TS]:=run_id;
-                        end
-                      else
-                        begin
-                          if (date>version_last_date^[version_id,TS]) then
-                            begin
-                              version_last_date^[version_id,TS]:=date;
-                              version_last_date_id^[version_id,TS]:=run_id;
-                            end;
-                          if date<version_first_date^[version_id,TS] then
-                            begin
-                              version_first_date^[version_id,TS]:=date;
-                              version_first_date_id^[version_id,TS]:=run_id;
-                            end;
-                        end;
-                      inc(version_count^[version_id,TS]);
-                    end;
-                end
-              else if Fdebug then
-                writeln(stdout,'Error for Result, S=',S);
-            end;
-          DumpLn(Format('<p>Total = %d </p>',[total_count]));
-          if Total_count > 0 then
-            DumpLn(Format('<p>OK=%d Percentage= %3.2f </p>',[OK_count,OK_count*100/total_count]));
-          if Skip_count > 0 then
-            DumpLn(Format('<p>Skipped=%d Percentage= %3.2f </p>',[Skip_count,Skip_count*100/total_count]));
-          if total_count>0 then
-            begin
-              TableStart(5,True);
-              RowStart;
-              CellStart;
-              DumpLn('Result type');
-              CellNext;
-              DumpLn('Cat.');
-              CellNext;
-              DumpLn('Count');
-              CellNext;
-              DumpLn('Percentage');
-              CellNext;
-              DumpLn('First date');
-              CellNext;
-              DumpLn('Last Date');
-              CellEnd;
-            end;
-          For TS:=FirstStatus to LastStatus do
-            if Result_count[TS]>0 then
-              begin
-                RowNext;
-                CellStart;
-                DumpLn(StatusText[TS]);
-                CellNext;
-                CellNext;
-                DumpLn(Format('%d',[Result_count[TS]]));
-                CellNext;
-                DumpLn(Format('%3.1f',[Result_count[TS]*100/total_count]));
-                CellNext;
-
-                DumpLn(FormatDetailURL(IntToStr(first_date_id[TS]),
-                  DateTimeToStr(first_date[TS])));
-                DumpLn(' '+GetFailCount(first_date_id[TS]));
-                CellNext;
-                DumpLn(FormatDetailURL(IntToStr(last_date_id[TS]),
-                  DateTimeToStr(last_date[TS])));
-                DumpLn(' '+GetFailCount(last_date_id[TS]));
-                CellEnd;
-                if assigned(cpu_count) then
-                  begin
-                    for i:=1 to cpu_last do
-                      if cpu_count^[i,TS]>0 then
-                        begin
-                          RowNext;
-                          CellStart;
-                          CellNext;
-                          DumpLn(GetSingleton('SELECT TC_NAME FROM TESTCPU WHERE TC_ID='+IntToStr(i)));
-                          CellNext;
-                          DumpLn(Format('%d',[cpu_count^[i,TS]]));
-                          CellNext;
-                          DumpLn(Format('%3.1f',[cpu_count^[i,TS]*100/result_count[TS]]));
-                          CellNext;
-                          DumpLn(FormatDetailURL(IntToStr(cpu_first_date_id^[i,TS]),
-                            DateTimeToStr(cpu_first_date^[i,TS])));
-                          DumpLn(' '+GetFailCount(cpu_first_date_id^[i,TS]));
-                          CellNext;
-                          DumpLn(FormatDetailURL(IntToStr(cpu_last_date_id^[i,TS]),
-                            DateTimeToStr(cpu_last_date^[i,TS])));
-                          DumpLn(' '+GetFailCount(cpu_last_date_id^[i,TS]));
-                          CellEnd;
-                        end;
-                  end;
-                if assigned(os_count) then
-                  begin
-                    for i:=1 to os_last do
-                      if os_count^[i,TS]>0 then
-                        begin
-                          RowNext;
-                          CellStart;
-                          CellNext;
-                          DumpLn(GetSingleton('SELECT TO_NAME FROM TESTOS WHERE TO_ID='+IntToStr(i)));
-                          CellNext;
-                          DumpLn(Format('%d',[os_count^[i,TS]]));
-                          CellNext;
-                          DumpLn(Format('%3.1f',[os_count^[i,TS]*100/result_count[TS]]));
-                          CellNext;
-                          DumpLn(FormatDetailURL(IntToStr(os_first_date_id^[i,TS]),
-                            DateTimeToStr(os_first_date^[i,TS])));
-                          DumpLn(' '+GetFailCount(os_first_date_id^[i,TS]));
-                          CellNext;
-                          DumpLn(FormatDetailURL(IntToStr(os_last_date_id^[i,TS]),
-                            DateTimeToStr(os_last_date^[i,TS])));
-                          DumpLn(' '+GetFailCount(os_last_date_id^[i,TS]));
-                          CellEnd;
-
-                        end;
-
-                  end;
-
-                if assigned(version_count) then
-                  begin
-                    for i:=1 to version_last do
-                      if version_count^[i,TS]>0 then
-                        begin
-                          RowNext;
-                          CellStart;
-                          CellNext;
-                          DumpLn(GetSingleton('SELECT TV_VERSION FROM TESTVERSION WHERE TV_ID='+IntToStr(i)));
-                          CellNext;
-                          DumpLn(Format('%d',[version_count^[i,TS]]));
-                          CellNext;
-                          DumpLn(Format('%3.1f',[version_count^[i,TS]*100/result_count[TS]]));
-                          CellNext;
-                          DumpLn(FormatDetailURL(IntToStr(version_first_date_id^[i,TS]),
-                            DateTimeToStr(version_first_date^[i,TS])));
-                          DumpLn(' '+GetFailCount(version_first_date_id^[i,TS]));
-                          CellNext;
-                          DumpLn(FormatDetailURL(IntToStr(version_last_date_id^[i,TS]),
-                            DateTimeToStr(version_last_date^[i,TS])));
-                          DumpLn(' '+GetFailCount(version_last_date_id^[i,TS]));
-                          CellEnd;
-
-                        end;
-
-                  end;
-
-              end;
-          if total_count>0 then
-            begin
-              TableEnd;
-              RecNo:=1;
-            end;
-          If FDebug or FListAll then
-           begin
-
-            With CreateTableProducer(Q) do
-              Try
-                Border:=True;
-                FL:='RUN,Date,OK,SKIP,Result';
-                if FSubmitter='' then
-                  FL:=FL+',Submitter';
-                if FMachine='' then
-                  FL:=FL+',Machine';
-                if Fcomment='' then
-                  FL:=FL+',Comment';
-                if (FOS='') or (GetOSName(FOS)='All') then
-                  FL:=FL+',OS';
-                if (FCPU='') or (GetCPUName(FCPU)='All') then
-                  FL:=FL+',CPU';
-                if (FVersion='') or (GetVersionName(FVersion)='All') then
-                  FL:=FL+',Version';
-                FL:=FL+',Fails,CompDate';
-                FL:=FL+',Tests_rev,RTL_rev,Compiler_rev,Packages_rev';
-                CreateColumns(FL);
-                //TableColumns.Delete(TableColumns.ColumnByName('TR_TEST_FK').Index);
-                TableColumns.ColumnByNAme('RUN').OnGetCellContents:=
-                  @FormatTestRunOverview;
-                //OnGetRowAttributes:=@GetRunRowAttr;
-                TableColumns.ColumnByNAme('Result').OnGetCellContents:=
-                  @FormatTestResult;
-                //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
-                CreateTable(Response);
-              Finally
-                Free;
-              end;
-           end;
-
-          Finally
-            Close;
-          end;
-        finally
-          Free;
-        end;
-             //If FDebug then
-            Category:='1';
-            if FRunId<>'' then
-              begin
-                Category:=getsingleton('select TU_CATEGORY_FK from TESTRUN where TU_ID='+FRunId);
-                FVersionBranch:=GetVersionName(getsingleton('select TU_VERSION_FK from TESTRUN where TU_ID='+fRunId));
-                LLog:='';
-                Try
-                LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
-                     +') and (TR_TESTRUN_FK='+frunid+')');
-                if LLog<>'' then
-                  begin
-                    HeaderStart(2);
-                    DumpLn('LLog of '+FRunId+':');
-                    HeaderEnd(2);
-                    PreformatStart;
-                    system.Write(LLog);
-                    system.flush(output);
-                    PreformatEnd;
-                  end;
-                Finally
-                  if LLog='' then
-                    begin
-                      HeaderStart(2);
-                      DumpLn('No log of '+FRunId+'.');
-                      HeaderEnd(2);
-                    end;
-                end;
-              end;
-            if FCompareRunId<>'' then
-              begin
-                LLog:='';
-                Try
-                LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
-                     +') and (TR_TESTRUN_FK='+fcomparerunid+')');
-                if LLog<>'' then
-                  begin
-                    HeaderStart(2);
-                    DumpLn('Log of '+FCompareRunId+':');
-                    HeaderEnd(2);
-                    PreformatStart;
-                    system.Write(LLog);
-                    system.flush(output);
-                    PreformatEnd;
-                  end;
-                Finally
-                  if LLog='' then
-                    begin
-                      HeaderStart(2);
-                      DumpLn('No log of '+FCompareRunId+'.');
-                      HeaderEnd(2);
-                    end;
-                end;
-              end;
-            if FDebug then
-              DumpLn('After log.');
-            Source:='';
-            Try
-              if ftestfileid <> '' then
-              begin
-                Source:=getsingleton('select T_SOURCE from TESTS where T_ID='+ftestfileid);
-                if Source<>'' then
-                  begin
-                    HeaderStart(2);
-                    DumpLn('Source:');
-                    HeaderEnd(2);
-                    PreformatStart;
-                    system.Write(Source);
-                    system.flush(output);
-                    PreformatEnd;
-                  end;
-              end;
-            Finally
-            Base:='trunk';
-            if  FVersionBranch<>'' then
-              begin
-                // Test all but last version, which is assumed to be trunk
-                for ver:=low(known_versions) to pred(high(known_versions)) do
-                  if ver_string[ver]=FVersionBranch then
-                    begin
-                      base:=ver_branch[ver];
-                      break;
-                    end;
-              end;
-            if UseGit then
-              begin
-                index:=pos('/',Base);
-                if index>0 then
-                  Base:=Copy(Base,index+1,length(Base));
-                if Base='trunk' then
-                  Base:='main';
-                FViewVCURL:=ViewGitHashURL+Base;
-              end
-            else
-              FViewVCURL:=ViewURL+Base;
-            if Category='1' then
-              FViewVCUrl:=FViewVCURL+TestsSubDir
-            else
-              begin
-                FViewVCUrl:=FViewVCURL+DataBaseSubDir;
-                // This assumes that type TAnyType is
-                // defined in anytype.pas source PM
-                if pos('/',FTestFileName)>0 then
-                  FTestfilename:=lowercase(copy(FTestFilename,2,pos('/',FTestFilename)-2)+'.pas');
-              end;
-            if Source='' then
-              begin
-                HeaderStart(3);
-                DumpLn('<P>No Source in TestSuite DataBase.</P>');
-                DumpLn('Link to SVN view of '+
-                  '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
-                  '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
-                HeaderEnd(3);
-              end
-            else
-              begin
-                HeaderStart(3);
-                DumpLn('Link to SVN view of '+
-                  '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
-                  '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
-                HeaderEnd(3);
-              end;
-            end;
-             if FDebug then
-              DumpLn('After Source.');
-    end;
-
-    end;
-  if assigned(os_count) then
-    begin
-      FreeMem(os_count);
-      FreeMem(os_first_date);
-      FreeMem(os_first_date_id);
-      FreeMem(os_last_date);
-      FreeMem(os_last_date_id);
-    end;
-
-  if assigned(cpu_count) then
-    begin
-      FreeMem(cpu_count);
-      FreeMem(cpu_first_date);
-      FreeMem(cpu_first_date_id);
-      FreeMem(cpu_last_date);
-      FreeMem(cpu_last_date_id);
-    end;
-  if assigned(version_count) then
-    begin
-      FreeMem(version_count);
-      FreeMem(version_first_date);
-      FreeMem(version_first_date_id);
-      FreeMem(version_last_date);
-      FreeMem(version_last_date_id);
-    end;
-end;
-
-Procedure TTestSuite.ShowRunComparison;
-
-Var
-  S : String;
-  Qry : String;
-  Q : TSQLQuery;
-  FL : String;
-
-begin
-  ConnectToDB;
-  ContentType:='text/html';
-  EmitContentType;
-  EmitDocType;
-  EmitTitle(Title+' : Compare 2 runs');
-  With FHTMLWriter do
-    begin
-    HeaderStart(1);
-    DumpLn('Test suite results for run '+FRunID+' vs. '+FCompareRunID);
-    HeaderEnd(1);
-    HeaderStart(2);
-    DumpLn('Test run data: ');
-    HeaderEnd(2);
-    If ShowRunData then
-      begin
-      HeaderStart(2);
-      DumpLn('Detailed test run results:');
-
-      FL:='';
-      If FOnlyFailed or FNoSkipped then
-        begin
-        FL:='';
-        If FOnlyFailed then
-          FL:='successful';
-        if FNoSkipped then
-          begin
-          If (FL<>'') then
-            FL:=FL+' and ';
-          FL:=FL+'skipped';
-          end;
-        DumpLn(' ('+FL+' tests are hidden)');
-        end;
-      HeaderEnd(2);
-      ParaGraphStart;
-      Q:=CreateDataset('');
-      S:='with tr1 as (SELECT * FROM '+TESTRESULTSTableName(FRunId)+ ' WHERE TR_TESTRUN_FK='+FRunID+'), '+
-         '  tr2 as (SELECT * FROM '+TESTRESULTSTableName(FCompareRunId)+' WHERE TR_TESTRUN_FK='+FCompareRunID+')'+
-         ' SELECT T_ID as id,T_NAME as Filename,tr1.TR_SKIP as Run1_Skipped,'
-         +'tr2.TR_SKIP as Run2_Skipped,tr1.TR_OK as Run1_OK,'
-         +'tr2.TR_OK as Run2_OK, tr1.TR_Result as Run1_Result,'
-         +'tr2.TR_RESULT as Run2_Result '
-         +'FROM TESTS, tr2 LEFT JOIN tr1 USING (TR_TEST_FK) '
-         +'WHERE ((tr1.TR_SKIP IS NULL) or (tr2.TR_SKIP IS NULL) or '
-         +' (%s (tr1.TR_Result<>tr2.TR_Result)))'
-         +'and (T_ID=tr2.TR_TEST_FK)';
-      If FNoSkipped then
-        begin
-        Qry:='(((tr1.TR_SKIP) and (not tr2.TR_OK) and (not tr2.TR_SKIP)) or '
-           +'((not tr1.TR_OK) and (not tr1.TR_SKIP) and (tr2.TR_SKIP)) or '
-           +'((not tr1.TR_SKIP) and (not tr2.TR_SKIP))) and ';
-        end
-      else
-        Qry:='';
-      Qry:=Format(S,[Qry]);
-//      DumpLn(Qry);
-      If FDebug then
-        begin
-        system.WriteLn('Query: '+Qry);
-        system.Flush(stdout);
-        end;
-      FRunCount:=0;
-      FRunSkipCount:=0;
-      FRunFailedCount:=0;
-      Q.SQL.Text:=Qry;
-      With Q do
-        try
-          Open;
-          Try
-            With CreateTableProducer(Q) do
-              Try
-                Border:=True;
-                FL:='Id,Filename,Run1_OK,Run2_OK';
-                If Not FNoSkipped then
-                  FL:=FL+',Run1_Skipped,Run2_Skipped';
-                FL:=FL+',Run1_Result,Run2_Result';
-                CreateColumns(FL);
-                OnGetRowAttributes:=@GetRunRowAttr;
-                TableColumns.ColumnByNAme('Id').OnGetCellContents:=
-                  @FormatFileIDDetails;
-                TableColumns.ColumnByNAme('Run1_Result').OnGetCellContents:=
-                  @FormatTestResult;
-                TableColumns.ColumnByNAme('Run2_Result').OnGetCellContents:=
-                  @FormatTestResult;
-                TableColumns.ColumnByNAme('Filename').OnGetCellContents:=
-                 @FormatFileDetails;
-                //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
-                CreateTable(Response);
-              Finally
-                Free;
-              end;
-            DumpLn(format('<p>Record count: %d</P>',[Q.RecordCount]));
-          Finally
-            Close;
-          end;
-        finally
-          Free;
-        end;
-      If Not (FRunCount=0) and not (FNoSkipped or FOnlyFailed) then
-        begin
-        ParaGraphStart;
-        TagStart('IMG',Format('Src="'+TestsuiteCGIURL+
-        '?action=2&amp;pietotal=%d&amp;piefailed=%d&amp;pieskipped=%d"'+
-        ' ALT="total=%d, failed=%d, skipped=%d"',
-        [FRunCount,FRunFailedCount,FRunSkipCount,
-          FRunCount,FRunFailedCount,FRunSkipCount
-          ]));
-        end;
-      end
-    else
-      DumpLn('No data for test run with ID: '+FRunID);
-    end;
-end;
-
-procedure TTestSuite.GetRunRowAttr(Sender: TObject; var BGColor: String;
-  var Align: THTMLAlign; var VAlign: THTMLValign; var CustomAttr: String);
-
-Var
-  P : TTableProducer;
-  Skip1Field, Skip2Field, Run1Field, Run2Field : TField;
-begin
-  P:=(Sender as TTAbleProducer);
-  Inc(FRunCount);
-  If (FOnlyFailed and FNoSkipped) then
-    begin
-    If (P.CurrentRow Mod 2)=0 then
-      BGColor:='#EEEEEE'
-    end
-  else
-    begin
-    Skip1Field := P.Dataset.FindField('Skipped');
-    if Skip1Field = nil then
-      begin
-      Skip1Field := P.Dataset.FindField('Run1_Skipped');
-      Skip2Field := P.Dataset.FindField('Run2_Skipped');
-      end
-    else
-      Skip2Field := nil;
-    Run1Field := P.Dataset.FindField('OK');
-    if Run1Field = nil then
-      Run1Field := P.Dataset.FindField('Run1_OK');
-    Run2Field := P.Dataset.FindField('OK');
-    if Run2Field = nil then
-      Run2Field := P.Dataset.FindField('Run2_OK');
-    If (not FNoSkipped) and ((Skip1Field.AsBoolean)
-        or ((Skip2Field <> nil) and (Skip2Field.AsBoolean))) then
-      begin
-      Inc(FRunSkipCount);
-      BGColor:='yellow';    // Yellow
-      end
-    else If Run2Field.AsBoolean then
-      begin
-      if Run1Field.AsString='' then
-        BGColor:='#68DFB8'
-      else if Run1Field.AsBoolean then
-        BGColor:='#98FB98';    // pale Green
-      end
-    else if Not Run2Field.AsBoolean then
-      begin
-      Inc(FRunFailedCount);
-      if Run1Field.AsString='' then
-        BGColor:='#FF82AB'    // Light red
-      else if Not Run1Field.AsBoolean then
-        BGColor:='#FF225B';
-      end;
-    end;
-end;
-
-procedure TTestSuite.FormatFailedOverview(Sender: TObject; var CellData: String);
-
-Var
-  S: String;
-  P : TTableProducer;
-
-begin
-  P:=(Sender as TTableProducer);
-  S:=Format(SDetailsURL,[P.DataSet.FieldByName('ID').AsString]);
-  S:=S+'&amp;failedonly=1&amp;noskipped=1';
-  CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
-end;
-
-
-function TTestSuite.FormatDetailURL(const RunIdStr, CellData : String) : string;
-Var
-  S : String;
-begin
-  S:=Format(SDetailsURL,[RunIdStr]);
-  if FOnlyFailed then
-    S:=S+'&amp;failedonly=1';
-  if FNoSkipped then
-    S:=S+'&amp;noskipped=1';
-  FormatDetailURL:=Format('<A HREF="%s">%s</A>',[S,CellData]);
-end;
-
-procedure TTestSuite.FormatTestRunOverview(Sender: TObject; var CellData: String);
-Var
-  S: String;
-  P : TTableProducer;
-begin
-  P:=(Sender as TTableProducer);
-  S:=Format(SDetailsURL,[P.DataSet.FieldByName('RUN').AsString]);
-  if FOnlyFailed then
-    S:=S+'&amp;failedonly=1';
-  if FNoSkipped then
-    S:=S+'&amp;noskipped=1';
-  CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
-end;
-
-procedure TTestSuite.FormatSVN(Sender: TObject; var CellData: String);
-begin
-  FormatSVNData(CellData);
-end;
-
-procedure TTestSuite.FormatSVNData(var CellData: String);
-Var
-  S, Rev, SubStr, Remaining : String;
-  P : TTableProducer;
-  pos_colon, pos_sep : longint;
-begin
-  pos_sep:=pos('/', CellData);
-  if pos_sep=0 then
-    begin
-      pos_colon:=pos(':',CellData);
-      if UseGit then
-        S:=ViewGitHashURL+copy(CellData,pos_colon+1,length(CellData))
-      else
-        S:=ViewRevURL+copy(CellData,pos_colon+1,length(CellData));
-      CellData:=Format('<A HREF="%s" target="_blank">%s</A>',[S,CellData]);
-    end
-  else
-    begin
-      SubStr:=Copy(CellData,1,pos_sep-1);
-      Remaining:=Copy(CellData,pos_sep+1,length(CellData));
-      CellData:='';
-      while SubStr<>'' do
-        begin
-          pos_colon:=pos(':',SubStr);
-          Rev:=copy(SubStr,pos_colon+1,length(SubStr));
-          { Remove suffix like M for modified...}
-          while (length(Rev)>0) and (not (Rev[length(Rev)] in ['0'..'9','a'..'f','A'..'F'])) do
-            Rev:=Copy(Rev,1,length(Rev)-1);
-          if UseGit then
-            S:=ViewGitHashURL+Rev
-          else
-            S:=ViewRevURL+Rev;
-          CellData:=CellData+Format('<A HREF="%s" target="_blank">%s</A>',[S,SubStr]);
-          if Remaining='' then
-            SubStr:=''
-          else
-            begin
-              pos_sep:=pos('/',Remaining);
-              if pos_sep=0 then
-                pos_sep:=length(Remaining)+1;
-              CellData:=CellData+':';
-              SubStr:=Copy(Remaining,1,pos_sep-1);
-              Remaining:=Copy(Remaining,pos_sep+1,length(Remaining));
-            end;
-        end;
-    end;
-end;
-
-procedure TTestSuite.FormatFileIDDetails(Sender: TObject; var CellData: String);
-
-Var
-  S: String;
-  P : TTableProducer;
-
-begin
-  P:=(Sender as TTableProducer);
-  if FVersion<>'' then
-    S:=Format(TestSuiteCGIURL + '?action=%d&amp;version=%s&amp;testfileid=%s',
-       [faction_show_history,FVersion,P.DataSet.FieldByName('Id').AsString])
-  else
-    S:=Format(TestSuiteCGIURL + '?action=%d&amp;testfileid=%s',
-       [faction_show_history,P.DataSet.FieldByName('Id').AsString]);
-  CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
-end;
-
-
-procedure TTestSuite.FormatFileDetails(Sender: TObject; var CellData: String);
-
-Var
-  S: String;
-  P : TTableProducer;
-
-begin
-  P:=(Sender as TTableProducer);
-  if FCompareRunID<>'' then
-    S:=Format(TestSuiteCGIURL + '?action=%d&amp;run1id=%s&amp;run2id=%s&amp;testfileid=%s',
-       [faction_show_one_test,FRunID,FCompareRunID,P.DataSet.FieldByName('Id').AsString])
-  else
-    S:=Format(TestSuiteCGIURL + '?action=%d&amp;run1id=%s&amp;testfileid=%s',
-       [faction_show_one_test,FRunID,P.DataSet.FieldByName('Id').AsString]);
-  CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
-end;
-
-procedure TTestSuite.FormatTestResult(Sender: TObject; var CellData: String);
-
-Var
-  Res : longint;
-  Error:word;
-  TS : TTestStatus;
-begin
-  Val(CellData,Res,Error);
-  if (Error=0) and (Res>=longint(FirstStatus)) and
-     (Res<=longint(LastStatus)) then
-    begin
-      TS:=TTestStatus(Res);
-      CellData:=StatusText[TS];
-    end;
-end;
-
-Procedure TTestSuite.CreateRunPie;
-
-Var
-  I : TFPMemoryImage;
-  M : TMemoryStream;
-
-begin
-  ftFont.InitEngine;
-  FontMgr.SearchPath:='/usr/lib/X11/fonts/truetype';
-  I:=TFPMemoryImage.Create(320,320);
-  try
-    If FRunCount=0 Then
-      Raise Exception.Create('Invalid parameters passed to script: No total count');
-    DoDrawPie(I,FRunSkipCount,FRunFailedCount,FRunCount);
-    M:=TMemoryStream.Create;
-    Try
-      With TFPWriterPNG.Create do
-        try
-          UseAlpha:=True;
-          ImageWrite(M,I);
-        Finally
-          Free;
-        end;
-      ContentType:='image/png';
-      //EmitDocType;
-      EmitContentType;
-      M.Position:=0;
-      Response.CopyFrom(M,M.Size);
-    Finally
-      M.Free;
-    end;
-  Finally
-    I.Free;
-  end;
-end;
-
-Procedure TTestSuite.DoDrawPie(Img : TFPCustomImage; Skipped,Failed,Total : Integer);
-
-Var
-  Cnv : TFPImageCanvas;
-
-  Procedure AddPie(X,Y,R : Integer; AStart,AStop : Double; Col : TFPColor);
-
-  Var
-    DX,Dy : Integer;
-
-  begin
-    DX:=Round(R*Cos(AStart));
-    DY:=Round(R*Sin(AStart));
-    Cnv.Line(X,Y,X+DX,Y-DY);
-    DX:=Round(R*Cos(AStop));
-    DY:=Round(R*Sin(AStop));
-    Cnv.Line(X,Y,X+DX,Y-Dy);
-    DX:=Round(R/2*Cos((AStart+AStop)/2));
-    DY:=Round(R/2*Sin((AStart+AStop)/2));
-    Cnv.Brush.FpColor:=Col;
-    Cnv.FloodFill(X+DX,Y-DY);
-  end;
-
-  Function FractionAngle(F,T : Integer): Double;
-
-  begin
-    Result:=(2*Pi*(F/T))
-  end;
-
-Var
-  W,H,FH,CR,RA : Integer;
-  A1,A2,FR,SR,PR : Double;
-  R : TRect;
-  F : TFreeTypeFont;
-
-begin
-  F:=TFreeTypeFont.Create;
-  With F do
-    begin
-    Name:='arial';
-    FontIndex:=0;
-    Size:=12;
-    FPColor:=colred;
-    AntiAliased:=False;
-    Resolution:=96;
-    end;
-  if FDebug then
-    Writeln(stdout,'Creating image');
-  Cnv:=TFPImageCanvas.Create(Img);
-  if FDebug then
-    Writeln(stdout,'CNV=0x',hexstr(ptruint(cnv),16));
-
-  if FDebug then
-   Writeln(stdout,'Getting width and height');
-  W:=Img.Width;
-  H:=Img.Height;
-  if FDebug then
-    begin
-      Writeln(stdout,'width=',W,' height=',H);
-      //system.flush(stdout);
-    end;
-  // Writeln('Transparant');
-  cnv.Brush.Style:=bsSolid;
-  cnv.Brush.FPColor:=colTransparent;
-  cnv.Pen.FPColor:=colWhite;
-  Cnv.Rectangle(0,0,W,H);
-  if FDEbug then
-    Writeln(stdout,'Setting font');
-  Cnv.Font:=F;
-  if FDebug then
-    Writeln(stdout,'Getting textwidth ');
-  FH:=CNV.GetTextHeight('A');
-  If FH=0 then
-    FH:=14; // 3 * 14;
-  if FDebug then
-    writeln(stdout,'FH=',FH);
-  Inc(FH,3);
-  R.Top:=FH*4;
-  R.Left:=0;
-  R.Bottom:=H;
-  CR:=H-(FH*4);
-  If W>CR then
-    R.Right:=CR
-  else
-    R.Right:=W;
-  Ra:=CR div 2;
-  if FDEbug then
-    begin
-      Writeln(stdout,'Setting pen color');
-      system.flush(stdout);
-    end;
-  Cnv.Pen.FPColor:=colBlack;
-  if FDebug then
-    begin
-      Writeln(stdout,'Palette size : ',Img.Palette.Count);
-      Writeln(stdout,'Setting brush style');
-      system.flush(stdout);
-    end;
-  cnv.brush.FPColor:=colDkGray;
-  SR:=Skipped/Total;
-  FR:=Failed/Total;
-  PR:=1-SR-FR;
-  cnv.font.FPColor:=colDkGray;
-  Cnv.Textout(1,FH*2,Format('%d Skipped (%3.1f%%)',[Skipped,SR*100]));
-//  cnv.pen.width:=1;
-  // Writeln('Drawing ellipse');
-  Cnv.Ellipse(R);
-  if FDebug then
-    begin
-      Writeln(stdout,'Setting text');
-      system.flush(stdout);
-    end;
-  A1:=0;
-  A2:=A1+FractionAngle(Failed,Total);
-  cnv.font.FPColor:=colRed;
-  Cnv.Textout(1,FH*3,Format('%d Failed (%3.1f%%)',[Failed,FR*100]));
-  AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColRed);
-  cnv.font.FPColor:=colGreen;
-  Cnv.Textout(1,FH,Format('%d Passed (%3.1f%%)',[Total-Skipped-Failed,PR*100]));
-  // Writeln('Palette size : ',Img.Palette.Count);
-  A1:=A2;
-  A2:=A1+FractionAngle(Total-(Skipped+Failed),Total);
-  AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColGreen);
-  // Writeln('Palette size : ',Img.Palette.Count);
-  // Writeln('All done');
-end;
-
-begin
-  if paramstr(0)<>'' then
-    TestsuiteCGIURL:=TestsuiteURLPrefix+'cgi-bin/'+extractfilename(paramstr(0))
-  else
-    TestsuiteCGIURL:=TestsuiteURLPrefix+'cgi-bin/'+TestsuiteBin;
-
-  ShortDateFormat:='yyyy/mm/dd';
-end.

tests/utils/testu.pp

@@ -1,640 +0,0 @@
-{$mode objfpc}
-{$modeswitch advancedrecords}
-{$h+}
-
-unit testu;
-
-Interface
-
-uses
-  classes, sysutils, tresults;
-{ ---------------------------------------------------------------------
-    utility functions, shared by several programs of the test suite
-  ---------------------------------------------------------------------}
-
-type
-  TCharSet = set of char;
-
-  TVerboseLevel=(V_Abort,V_Error,V_Warning,V_Normal,V_Debug,V_SQL);
-
-  TConfig = record
-    NeedOptions,
-    DelOptions,
-    NeedCPU,
-    SkipCPU,
-    SkipEmu,
-    NeedTarget,
-    SkipTarget,
-    MinVersion,
-    MaxVersion,
-    KnownRunNote,
-    KnownCompileNote,
-    RecompileOpt: string;
-    ResultCode    : longint;
-    KnownRunError : longint;
-    KnownCompileError : longint;
-    NeedRecompile : boolean;
-    NeedLibrary   : boolean;
-    NeededAfter   : boolean;
-    IsInteractive : boolean;
-    IsKnownRunError,
-    IsKnownCompileError : boolean;
-    NoRun         : boolean;
-    UsesGraph     : boolean;
-    ShouldFail    : boolean;
-    Timeout       : longint;
-    Category      : string;
-    Note          : string;
-    Files         : string;
-    ConfigFileSrc : string;
-    ConfigFileDst : string;
-    WpoParas      : string;
-    WpoPasses     : longint;
-    DelFiles      : string;
-    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;
-  MaxLogSize : LongInt = 50000;
-
-
-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 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 }
-  TargetHasDosStyleDirectories : boolean = false;
-  TargetAmigaLike : boolean = false;
-  TargetIsMacOS : boolean = false;
-  TargetIsUnix : boolean = false;
-
-{ File path helper functions }
-function SplitPath(const s:string):string;
-function SplitBasePath(const s:string): string;
-Function SplitFileName(const s:string):string;
-Function SplitFileBase(const s:string):string;
-Function SplitFileExt(const s:string):string;
-Function FileExists (Const F : String) : Boolean;
-Function PathExists (Const F : String) : Boolean;
-Function IsAbsolute (Const F : String) : boolean;
-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;
-  p: PChar;
-begin
-  p:=PChar(s);
-  i:=0;
-  while (p^ <> #0) and not (p^ in Delims) do begin
-    Inc(p);
-    Inc(i);
-  end;
-  GetToken:=Copy(s,1,i);
-  Delete(s,1,i+1);
-end;
-
-function SplitPath(const s:string):string;
-var
-  i : longint;
-begin
-  i:=Length(s);
-  while (i>0) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
-   dec(i);
-  SplitPath:=Copy(s,1,i);
-end;
-
-
-function SplitBasePath(const s:string): string;
-var
-  i : longint;
-begin
-  i:=1;
-  while (i<length(s)) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
-   inc(i);
-  if s[i] in  ['/','\'{$IFDEF MACOS},':'{$ENDIF}] then
-    dec(i);
-  SplitBasePath:=Copy(s,1,i);
-end;
-
-Function SplitFileName(const s:string):string;
-
-begin
-  Result:=ExtractFileName(S);
-end;
-
-Function SplitFileBase(const s:string):string;
-
-begin
-  Result:=ChangeFileExt(ExtractFileName(S),'');
-end;
-
-Function SplitFileExt(const s:string):string;
-begin
-  Result:=ExtractFileExt(S);
-end;
-
-
-Function FileExists (Const F : String) : Boolean;
-
-begin
-  Result:=SysUtils.FileExists(F);
-end;
-
-
-Function PathExists (Const F : String) : Boolean;
-{
-  Returns True if the file exists, False if not.
-}
-
-begin
-  Result:=DirectoryExists(F);
-end;
-
-{ extracted from rtl/macos/macutils.inc }
-
-function IsMacFullPath (const path: string): Boolean;
-  begin
-    if Pos(':', path) = 0 then    {its partial}
-      IsMacFullPath := false
-    else if path[1] = ':' then
-      IsMacFullPath := false
-    else
-      IsMacFullPath := true
-  end;
-
-
-Function IsAbsolute (Const F : String) : boolean;
-{
-  Returns True if the name F is a absolute file name
-}
-begin
-  IsAbsolute:=false;
-  if TargetHasDosStyleDirectories then
-    begin
-      if (F[1]='/') or (F[1]='\') then
-        IsAbsolute:=true;
-      if (Length(F)>2) and (F[2]=':') and ((F[3]='\') or (F[3]='/')) then
-        IsAbsolute:=true;
-    end
-  else if TargetAmigaLike then
-    begin
-      if (length(F)>0) and (Pos(':',F) <> 0) then
-        IsAbsolute:=true;
-    end
-  else if TargetIsMacOS then
-    begin
-      IsAbsolute:=IsMacFullPath(F);
-    end
-  { generic case }
-  else if (F[1]='/') then
-    IsAbsolute:=true;
-end;
-
-procedure Verbose(lvl:TVerboseLevel;const s:string);
-begin
-  case lvl of
-    V_Normal :
-      writeln(s);
-    V_Debug :
-      if DoVerbose then
-       writeln('Debug: ',s);
-    V_SQL :
-      if DoSQL then
-       writeln('SQL: ',s);
-    V_Warning :
-      writeln('Warning: ',s);
-    V_Error :
-      begin
-        writeln('Error: ',s);
-        halt(1);
-      end;
-    V_Abort :
-      begin
-        writeln('Abort: ',s);
-        halt(0);
-      end;
-  end;
-  Flush(output);
-end;
-
-procedure TrimB(var s:string);
-begin
-  while (s<>'') and (s[1] in [' ',#9]) do
-   delete(s,1,1);
-end;
-
-
-procedure TrimE(var s:string);
-begin
-  while (s<>'') and (s[length(s)] in [' ',#9]) do
-   delete(s,length(s),1);
-end;
-
-
-function upper(const s : string) : string;
-var
-  i,l  : longint;
-
-begin
-  Result:='';
-  L:=Length(S);
-  SetLength(Result,l);
-  for i:=1 to l do
-    if s[i] in ['a'..'z'] then
-     Result[i]:=char(byte(s[i])-32)
-    else
-     Result[i]:=s[i];
-end;
-
-function GetConfig(const logprefix,fn:string;var r:TConfig):boolean;
-var
-  t : text;
-  part,code : integer;
-  l : longint;
-  p : sizeint;
-  s,res: string;
-
-  function GetEntry(const entry:string):boolean;
-  var
-    i : longint;
-  begin
-    Getentry:=false;
-    Res:='';
-    if Upper(Copy(s,1,length(entry)))=Upper(entry) then
-     begin
-       Delete(s,1,length(entry));
-       TrimB(s);
-       if (s<>'') then
-        begin
-          if (s[1]='=') then
-           begin
-             delete(s,1,1);
-             i:=pos('}',s);
-             if i=0 then
-              i:=255
-             else
-              dec(i);
-             res:=Copy(s,1,i);
-             TrimB(res);
-             TrimE(res);
-           end;
-          Verbose(V_Debug,'Config: '+Entry+' = "'+Res+'"');
-          GetEntry:=true;
-        end;
-     end;
-  end;
-
-begin
-  FillChar(r,sizeof(r),0);
-  GetConfig:=false;
-  Verbose(V_Debug,'Reading '+fn);
-  assign(t,fn);
-  {$I-}
-   reset(t);
-  {$I+}
-  if ioresult<>0 then
-   begin
-     Verbose(V_Error,'Can''t open '+fn);
-     exit;
-   end;
-  r.Note:='';
-  while not eof(t) do
-   begin
-     readln(t,s);
-     if Copy(s,1,3)=#$EF#$BB#$BF then
-       delete(s,1,3);
-     TrimB(s);
-     if s<>'' then
-      begin
-        if s[1]='{' then
-         begin
-           delete(s,1,1);
-           TrimB(s);
-           if (s<>'') and (s[1]='%') then
-            begin
-              delete(s,1,1);
-              if GetEntry('OPT') then
-               r.NeedOptions:=res
-              else
-               if GetEntry('DELOPT') then
-                r.DelOptions:=res
-              else
-               if GetEntry('TARGET') then
-                r.NeedTarget:=res
-              else
-               if GetEntry('SKIPTARGET') then
-                r.SkipTarget:=res
-              else
-               if GetEntry('CPU') then
-                r.NeedCPU:=res
-              else
-               if GetEntry('SKIPCPU') then
-                r.SkipCPU:=res
-              else
-               if GetEntry('SKIPEMU') then
-                r.SkipEmu:=res
-              else
-               if GetEntry('VERSION') then
-                r.MinVersion:=res
-              else
-               if GetEntry('MAXVERSION') then
-                r.MaxVersion:=res
-              else
-               if GetEntry('RESULT') then
-                Val(res,r.ResultCode,code)
-              else
-               if GetEntry('GRAPH') then
-                r.UsesGraph:=true
-              else
-               if GetEntry('FAIL') then
-                r.ShouldFail:=true
-              else
-               if GetEntry('RECOMPILE') then
-	        begin
-                  r.NeedRecompile:=true;
-		  r.RecompileOpt:=res;
-		end
-              else
-               if GetEntry('NORUN') then
-                r.NoRun:=true
-              else
-               if GetEntry('NEEDLIBRARY') then
-                r.NeedLibrary:=true
-              else
-               if GetEntry('NEEDEDAFTER') then
-                r.NeededAfter:=true
-              else
-               if GetEntry('KNOWNRUNERROR') then
-                begin
-                  r.IsKnownRunError:=true;
-                  if res<>'' then
-                    begin
-                      val(res,l,code);
-                      if code>1 then
-                        begin
-                          part:=code;
-                          val(copy(res,1,code-1),l,code);
-                          delete(res,1,part);
-                        end;
-                      if code=0 then
-                        r.KnownRunError:=l;
-                      if res<>'' then
-                        r.KnownRunNote:=res;
-                    end;
-                end
-              else
-               if GetEntry('KNOWNCOMPILEERROR') then
-                begin
-                  r.IsKnownCompileError:=true;
-                  if res<>'' then
-                    begin
-                      val(res,l,code);
-                      if code>1 then
-                        begin
-                          part:=code;
-                          val(copy(res,1,code-1),l,code);
-                          delete(res,1,part);
-                        end;
-                      if code=0 then
-                        r.KnownCompileError:=l;
-                      if res<>'' then
-                        r.KnownCompileNote:=res;
-                    end;
-                end
-              else
-               if GetEntry('INTERACTIVE') then
-                r.IsInteractive:=true
-              else
-               if GetEntry('NOTE') then
-                begin
-                  R.Note:='Note: '+res;
-                  Verbose(V_Normal,r.Note);
-                end
-              else
-               if GetEntry('TIMEOUT') then
-                Val(res,r.Timeout,code)
-              else
-               if GetEntry('FILES') then
-                r.Files:=res
-              else
-                if GetEntry('CONFIGFILE') then
-                  begin
-                    l:=Pos(' ',res);
-                    if l>0 then
-                      begin
-                        r.ConfigFileSrc:=Copy(res,1,l-1);
-                        r.ConfigFileDst:=Copy(res,l+1,Length(res)-l+1);
-                        if r.ConfigFileSrc='' then
-                          Verbose(V_Error,'Config file source is empty');
-                        if r.ConfigFileDst='' then
-                          Verbose(V_Error,'Config file destination is empty');
-                      end
-                    else
-                      begin
-                        r.ConfigFileSrc:=res;
-                        r.ConfigFileDst:=res;
-                      end;
-                  end
-              else
-                if GetEntry('WPOPARAS') then
-                 r.wpoparas:=res
-              else
-                if GetEntry('WPOPASSES') then
-                 val(res,r.wpopasses,code)
-              else
-                if GetEntry('DELFILES') then
-                  r.DelFiles:=res
-              else
-                if GetEntry('EXPECTMSGS') then
-                  begin
-                    p:=Pos(',',res);
-                    while p>0 do
-                      begin
-                        Val(Copy(res,1,p-1),l,code);
-                        if code<>0 then
-                          Verbose(V_Error,'Invalid value in EXPECTMSGS list: '+Copy(res,1,p-1));
-                        Insert(l,r.ExpectMsgs,Length(r.ExpectMsgs));
-                        Delete(res,1,p);
-                        p:=Pos(',',res);
-                      end;
-                    Val(res,l,code);
-                    if code<>0 then
-                      Verbose(V_Error,'Invalid value in EXPECTMSGS list: '+res);
-                    Insert(l,r.ExpectMsgs,Length(r.ExpectMsgs));
-                  end
-              else
-               Verbose(V_Error,'Unknown entry: '+s);
-            end;
-         end
-        else
-         break;
-      end;
-   end;
-  close(t);
-  GetConfig:=true;
-end;
-
-Function GetFileContents (FN : String) : String;
-
-Var
-  F : Text;
-  S : String;
-
-begin
-  Result:='';
-  Assign(F,FN);
-  {$I-}
-  Reset(F);
-  If IOResult<>0 then
-    Exit;
-  {$I+}
-  While Not(EOF(F)) do
-    begin
-    ReadLn(F,S);
-    if length(Result)<MaxLogSize then
-      Result:=Result+S+LineEnding;
-    end;
-  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/tresults.pp

@@ -1,152 +0,0 @@
-{
-    This file is part of the Free Pascal test suite.
-    Copyright (c) 2007 by the Free Pascal development team.
-
-    This unit contains the different possible outcome
-    of a single test.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-{$h+}
-
-unit tresults;
-
-interface
-
-uses
-  teststr;
-
-
-Type
-  TTestStatus = (
-  stFailedToCompile,
-  stSuccessCompilationFailed,
-  stFailedCompilationsuccessful,
-  stSuccessfullyCompiled,
-  stFailedToRun,
-  stKnownRunProblem,
-  stSuccessFullyRun,
-  stSkippingGraphTest,
-  stSkippingInteractiveTest,
-  stSkippingKnownBug,
-  stSkippingCompilerVersionTooLow,
-  stSkippingCompilerVersionTooHigh,
-  stSkippingOtherCpu,
-  stSkippingOtherTarget,
-  stskippingRunUnit,
-  stskippingRunTest
-  );
-
-
-Const
-  FirstStatus = stFailedToCompile;
-  LastStatus = stskippingRunTest;
-
-  TestOK : Array[TTestStatus] of Boolean = (
-    False, // stFailedToCompile,
-    True,  // stSuccessCompilationFailed,
-    False, // stFailedCompilationsuccessful,
-    True,  // stSuccessfullyCompiled,
-    False, // stFailedToRun,
-    True,  // stKnownRunProblem,
-    True,  // stSuccessFullyRun,
-    False, // stSkippingGraphTest,
-    False, // stSkippingInteractiveTest,
-    False, // stSkippingKnownBug,
-    False, // stSkippingCompilerVersionTooLow,
-    False, // stSkippingCompilerVersionTooHigh,
-    False, // stSkippingOtherCpu,
-    False, // stSkippingOtherTarget,
-    False, // stskippingRunUnit,
-    False  // stskippingRunTest
-  );
-
-  TestSkipped : Array[TTestStatus] of Boolean = (
-    False,  // stFailedToCompile,
-    False,  // stSuccessCompilationFailed,
-    False,  // stFailedCompilationsuccessful,
-    False,  // stSuccessfullyCompiled,
-    False,  // stFailedToRun,
-    False,  // stKnownRunProblem,
-    False,  // stSuccessFullyRun,
-    True,   // stSkippingGraphTest,
-    True,   // stSkippingInteractiveTest,
-    True,   // stSkippingKnownBug,
-    True,   // stSkippingCompilerVersionTooLow,
-    True,   // stSkippingCompilerVersionTooHigh,
-    True,   // stSkippingOtherCpu,
-    True,   // stSkippingOtherTarget,
-    True,   // stskippingRunUnit,
-    True    // stskippingRunTest
-  );
-
-  ExpectRun : Array[TTestStatus] of Boolean = (
-    False,  // stFailedToCompile,
-    False,  // stSuccessCompilationFailed,
-    False,  // stFailedCompilationsuccessful,
-    True ,  // stSuccessfullyCompiled,
-    False,  // stFailedToRun,
-    False,  // stKnownRunProblem,
-    False,  // stSuccessFullyRun,
-    False,  // stSkippingGraphTest,
-    False,  // stSkippingInteractiveTest,
-    False,  // stSkippingKnownBug,
-    False,  // stSkippingCompilerVersionTooLow,
-    False,  // stSkippingCompilerVersionTooHigh,
-    False,  // stSkippingOtherCpu,
-    False,  // stSkippingOtherTarget,
-    False,  // stskippingRunUnit,
-    False   // stskippingRunTest
-   );
-
-  StatusText : Array[TTestStatus] of String = (
-    failed_to_compile,
-    success_compilation_failed,
-    failed_compilation_successful ,
-    successfully_compiled ,
-    failed_to_run ,
-    known_problem ,
-    successfully_run ,
-    skipping_graph_test ,
-    skipping_interactive_test ,
-    skipping_known_bug ,
-    skipping_compiler_version_too_low,
-    skipping_compiler_version_too_high,
-    skipping_other_cpu ,
-    skipping_other_target ,
-    skipping_run_unit ,
-    skipping_run_test
-  );
-
-  SQLField : Array[TTestStatus] of String = (
-    'TU_FAILEDTOCOMPILE',
-    'TU_SUCCESSFULLYFAILED',
-    'TU_FAILEDTOFAIL',
-    'TU_SUCCESFULLYCOMPILED',
-    'TU_FAILEDTORUN',
-    'TU_KNOWNPROBLEM',
-    'TU_SUCCESSFULLYRUN',
-    'TU_SKIPPEDGRAPHTEST',
-    'TU_SKIPPEDINTERACTIVETEST',
-    'TU_KNOWNBUG',
-    'TU_COMPILERVERIONTOOLOW',
-    'TU_COMPILERVERIONTOOHIGH',
-    'TU_OTHERCPU',
-    'TU_OTHERTARGET',
-    'TU_UNIT',
-    'TU_SKIPPINGRUNTEST'
-  );
-
-
-implementation
-
-end.
-

tests/utils/dbtests.pp → tests/utils/tsdb.pp

@@ -1,15 +1,16 @@
 {$mode objfpc}
 {$H+}
 
-unit dbtests;
+unit tsdb;
 
 Interface
 
 Uses
-  sqldb, tresults, testu, pqconnection;
+  sqldb, types, tstypes, tsstring, tsutils, pqconnection;
 
 const
   // Ini file constants
+  DefaultDBConfigFileName = '/etc/dbdigest.ini';
   SSection    = 'Database';
   KeyName     = 'Name';
   KeyHost     = 'Host';
@@ -17,7 +18,38 @@ const
   KeyPassword = 'Password';
   KeyPort     = 'Port';
 
+  // Query to run to get all test run test results.
+  // For test results that did not change, the last test result ID is returned.
+  // Needs formatting with 2 IDS : Run ID, Platform ID
+  SQLTestResultIDS =
+   'with testrunresultids as ( ' +
+   '  select ' +
+   '    tr_id as theid ' +
+   '  from ' +
+   '    testresults ' +
+   '  where ' +
+   '    (tr_testrun_fk=%d) ' +
+   '  union ' +
+   '  select ' +
+   '    tl_testresults_fk as theid ' +
+   '  from ' +
+   '    tests ' +
+   '    inner join testlastresults on (tl_test_fk=t_id) and (tl_platform_fk=%d) ' +
+   ')';
+
+  // Get all test results for a testrun (but not compile/run log)
+
+  SQLSelectTestResults =
+    SQLTestResultIDS +
+    'select ' +
+    '  T_ID as Id,T_NAME as Filename,TR_SKIP as Skipped, TR_OK as OK,TR_RESULT as Result ' +
+    'from ' +
+    '  testrunresultids ' +
+    '  left join testresults on (tr_id=theid) ' +
+    '  inner join tests on (tr_test_fk=t_id)';
+
 Type
+  TMapType = (mtCPU, mtOS, mtVersion);
 
   { TTestSQL }
 
@@ -34,26 +66,19 @@ Type
     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
+    Class Procedure FreeQueryResult (Var aQry : TSQLQuery);
+    Class Function  GetIntResultField (aQry : TSQLQuery; aFieldIndex : Integer) : Integer;
+    Class Function  GetInt64ResultField (aQry : TSQLQuery; aFieldIndex : Integer) : Int64;
+    Class Function  GetStrResultField (aQry : TSQLQuery; aFieldIndex : Integer) : String;
+    function InsertTestHistory(TestRunID, TestPreviousID: Integer): boolean;
+    // Overload adds prefix to actual call
     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
@@ -66,8 +91,17 @@ Type
     Function ConnectToDatabase : Boolean;
     // Disconnect from database
     Procedure DisconnectDatabase;
+    // Create query object.
+    function CreateQuery(const ASQL: String): TSQLQuery;
     // Execute a query, return true if it executed without error.
     Function  ExecuteQuery (Qry : String; 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;
+    Function CreateMap(aType : TMapType) : TIntegerDynArray;
     // Adding things
     // Add a category.
     Function AddCategory(const aName : String) : Integer;
@@ -93,31 +127,50 @@ Type
     // 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;
+    Function GetTestID(aName : string) : Integer;
+    Function GetTestName(aID : Integer) : string;
+    Function GetTestFileName(aID : Integer) : String;
+    Function GetTestSource(aID : Integer) : String;
     // Get OS ID based on OS name.
-    Function GetOSID(Name : String) : Integer;
+    Function GetOSID(aName : String) : Integer;
+    Function GetOSName(aID : Integer) : String;
     // Get CPU ID based on CPU name.
     Function GetCPUID(Name : String) : Integer;
+    Function GetCPUName(aID : Integer) : String;
+
     // Get category ID based on Category name.
-    Function GetCategoryID(Name : String) : Integer;
+    Function GetCategoryID(aName : String) : Integer;
+    Function GetCategoryName(aID : Integer) : String;
     // Get version ID based on version name.
-    Function GetVersionID(Name : String) : Integer;
+    Function GetVersionID(aName : String) : Integer;
+    Function GetVersionName(aID : Integer) : string;
     // Get platform ID based on OS, cpu, category, config.
     function GetPlatformID(aData: TTestRunData; aAllowCreate: Boolean): Integer;
+    function GetPlatformID(aVersionID, aOSID, aCPUID, aCategoryID : Integer; const aMachine, aConfig : String): Integer;
+    function GetPlatformID(aRunID : Int64): Integer;
     // Get run ID based on platform/date.
     Function GetRunID(aData : TTestRunData) : Int64;
+    function GetNextRunID(RunID: Int64): Int64;
+    function GetPreviousRunID(RunID: Int64): Int64;
+    Function GetRunData(aID : Int64; out aData : TTestRunData) : Boolean;
+    Function GetLastRunByPlatformAndDate(aPLatformID : Integer; aDate : TDateTime) : Integer;
+    // Get testinfo based on test ID
+    function GetTestInfo(aID: Int64; out aInfo: TTestInfo): Boolean;
     // Get last test result ID based on platform/test.
     function GetLastTestResult(aTestID, aPlatFormID: Integer): TTestResultData;
+    function GetFailCount(aRunID : Int64) : Int64;
     // Update tests
-    Function UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
+    Function UpdateTest(ID : Integer; Info : TConfig; Const Source : String) : Boolean;
     function UpdateTestResult(aData: TTestResultData): Int64;
     function UpdateTestRun(aData : TTestRunData): Boolean;
+    Function GetFailCount(aRunID : Integer) : Int64;
+
     // Create test if it does not exist yet.
-    Function RequireTestID(Name : String): Integer;
+    Function RequireTestID(const aName : String): Integer;
     // Delete all results from a test run.
     Function CleanTestRun(ID : Integer) : Boolean;
     // Escape SQL (quotes etc.
-    Class Function  EscapeSQL(S : String) : String;
+    Class Function  EscapeSQL(Const S : String) : String;
     // return SQL date
     Class Function  SQLDate(D : TDateTime) : String;
     // Rel src dir
@@ -262,58 +315,58 @@ begin
   end;
 end;
 
-class function TTestSQL.GetIntResultField(Res: TSQLQuery; Id: Integer): Integer;
+class function TTestSQL.GetIntResultField(aQry: TSQLQuery; aFieldIndex: Integer): Integer;
 
 
 begin
-  If (Res=Nil) or (res.IsEmpty) or (ID>=Res.Fields.Count) then
+  If (aQry=Nil) or (aQry.IsEmpty) or (aFieldIndex>=aQry.Fields.Count) then
     Result:=-1
   else
-    Result:=Res.Fields[ID].AsInteger;
-  testu.Verbose(V_SQL,'Field value '+IntToStr(Result));
+    Result:=aQry.Fields[aFieldIndex].AsInteger;
+  tsutils.Verbose(V_SQL,'Field value '+IntToStr(Result));
 end;
 
-class function TTestSQL.GetInt64ResultField(Res: TSQLQuery; Id: Integer): Int64;
+class function TTestSQL.GetInt64ResultField(aQry: TSQLQuery; aFieldIndex: Integer): Int64;
 begin
-  If (Res=Nil) or (res.IsEmpty) or (ID>=Res.Fields.Count) then
+  If (aQry=Nil) or (aQry.IsEmpty) or (aFieldIndex>=aQry.Fields.Count) then
     Result:=-1
   else
-    Result:=Res.Fields[ID].AsLargeInt;
-  testu.Verbose(V_SQL,'Field value '+IntToStr(Result));
+    Result:=aQry.Fields[aFieldIndex].AsLargeInt;
+  tsutils.Verbose(V_SQL,'Field value '+IntToStr(Result));
 end;
 
-class function TTestSQL.GetStrResultField(Res: TSQLQuery; Id: Integer): String;
+class function TTestSQL.GetStrResultField(aQry: TSQLQuery; aFieldIndex: Integer): String;
 begin
-  If (Res=Nil) or (res.IsEmpty) or (ID>=Res.Fields.Count) then
+  If (aQry=Nil) or (aQry.IsEmpty) or (aFieldIndex>=aQry.Fields.Count) then
     Result:=''
   else
-    Result:=Res.Fields[ID].AsString;
-  testu.Verbose(V_SQL,'Field value '+Result);
+    Result:=aQry.Fields[aFieldIndex].AsString;
+  tsutils.Verbose(V_SQL,'Field value '+Result);
 end;
 
 procedure TTestSQL.Verbose(aLevel: TVerboseLevel; const aMsg: string);
 begin
-  testu.Verbose(aLevel,logPrefix+aMsg);
+  tsutils.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'') '+
+  SQLInsert = 'INSERT INTO TESTPLATFORM (TP_CPU_FK, TP_OS_FK, TP_VERSION_FK, TP_CATEGORY_FK, TP_CONFIG, TP_MACHINE) '+
+              ' VALUES (%d, %d, %d, %d, ''%s'', ''%s'') '+
               '  RETURNING TP_ID';
 
 begin
   With aData do
-    Result:=IDQuery(Format(SQLInsert,[CPUID,OSID,VersionID,CategoryID,EscapeSQL(config)]));
+    Result:=IDQuery(Format(SQLInsert,[CPUID,OSID,VersionID,CategoryID,EscapeSQL(config),EscapeSQL(machine)]));
 end;
 
-class procedure TTestSQL.FreeQueryResult(var Res: TSQLQuery);
+class procedure TTestSQL.FreeQueryResult(var aQry: TSQLQuery);
 
 begin
-  if Assigned(Res) and Assigned(Res.Transaction) then
-    (Res.Transaction as TSQLTransaction).Commit;
-  FreeAndNil(Res);
+  if Assigned(aQry) and Assigned(aQry.Transaction) then
+    aQry.SQLTransaction.Commit;
+  FreeAndNil(aQry);
 end;
 
 function TTestSQL.IDQuery(Qry: String): Integer;
@@ -360,6 +413,36 @@ begin
     end;
 end;
 
+function TTestSQL.CreateMap(aType: TMapType): TIntegerDynArray;
+var
+  Qry : TSQLQuery;
+  lSQL : string;
+  lIdx : Integer;
+
+begin
+  Result:=[];
+  Case aType of
+    mtCPU : lSQL:='SELECT TC_ID FROM TESTCPU order by TC_ID';
+    mtOS  : lSQL:='SELECT TO_ID FROM TESTOS order by TO_ID';
+    mtVersion  : lSQL:='SELECT TV_ID FROM TESTVERSION order by TO_ID';
+  end;
+  Qry:=CreateQuery(lSQL);
+  try
+    Qry.PacketRecords:=-1;
+    Qry.Open;
+    SetLength(Result,Qry.RecordCount);
+    lIDx:=0;
+    While not Qry.EOF do
+      begin
+      Result[lIdx]:=Qry.Fields[0].AsInteger;
+      inc(lIdx);
+      Qry.Next;
+      end;
+  finally
+    Qry.Free;
+  end;
+end;
+
 constructor TTestSQL.create(aDatabaseName, aHost, aUser, aPassword: String; aPort: Word);
 begin
   FDatabaseName:=aDatabaseName;
@@ -375,12 +458,12 @@ begin
   inherited destroy;
 end;
 
-class function TTestSQL.EscapeSQL(S: String): String;
+class function TTestSQL.EscapeSQL(const S: String): String;
 
 begin
 //  Result:=StringReplace(S,'\','\\',[rfReplaceAll]);
   Result:=StringReplace(S,'''','''''',[rfReplaceAll]);
-  testu.Verbose(V_SQL,'EscapeSQL : "'+S+'" -> "'+Result+'"');
+  tsutils.Verbose(V_SQL,'EscapeSQL : "'+S+'" -> "'+Result+'"');
 end;
 
 
@@ -395,31 +478,60 @@ end;
   ---------------------------------------------------------------------}
 
 
-function TTestSQL.GetTestID(Name: string): Integer;
+function TTestSQL.GetTestID(aName: string): Integer;
 
 Const
   SFromName = 'SELECT T_ID FROM TESTS WHERE (T_NAME=''%s'')';
 
 begin
-  Result:=IDQuery(Format(SFromName,[Name]));
+  Result:=IDQuery(Format(SFromName,[aName]));
 end;
 
-function TTestSQL.GetOSID(Name: String): Integer;
+function TTestSQL.GetTestName(aID: Integer): string;
+begin
+  Result:=StringQuery(Format('SELECT T_NAME FROM TESTCPU WHERE (T_ID=%d)',[aID]));
+end;
+
+function TTestSQL.GetTestFileName(aID: Integer): String;
+begin
+  Result:=StringQuery(Format('SELECT T_NAME FROM TESTS WHERE (T_ID=%d)',[aID]));
+end;
+
+function TTestSQL.GetTestSource(aID: Integer): String;
+begin
+  Result:=StringQuery(Format('select T_SOURCE from TESTS where (T_ID=%d)',[aid]));
+end;
+
+function TTestSQL.GetOSID(aName: String): Integer;
 
 Const
   SFromName = 'SELECT TO_ID FROM TESTOS WHERE (TO_NAME=''%s'')';
 
 begin
-  Result:=IDQuery(Format(SFromName,[Name]));
+  Result:=IDQuery(Format(SFromName,[aName]));
+end;
+
+function TTestSQL.GetOSName(aID: Integer): String;
+begin
+  Result:=StringQuery(Format('SELECT TO_NAME FROM TESTOS WHERE (TO_ID=%d)',[aID]));
 end;
 
-function TTestSQL.GetVersionID(Name: String): Integer;
+function TTestSQL.GetVersionID(aName: String): Integer;
 
 Const
   SFromName = 'SELECT TV_ID FROM TESTVERSION WHERE (TV_VERSION=''%s'')';
 
 begin
-  Result:=IDQuery(Format(SFromName,[Name]));
+  Result:=IDQuery(Format(SFromName,[aName]));
+end;
+
+function TTestSQL.GetVersionName(aID: Integer): string;
+
+const
+  SQLSelectVersion = 'SELECT TV_VERSION FROM TESTVERSION WHERE (TV_ID=%d)';
+
+begin
+  Result:=StringQuery(Format(SQLSelectVersion,[aID]));
 end;
 
 function TTestSQL.GetPlatformID(aData: TTestRunData; aAllowCreate: Boolean): Integer;
@@ -431,15 +543,37 @@ Const
              '  AND (TP_OS_FK=%d)' +
              '  AND (TP_CPU_FK=%d)' +
              '  AND (TP_CATEGORY_FK=%d)' +
-             '  AND (TP_CONFIG=''%s'')';
+             '  AND (TP_CONFIG=''%s'')' +
+             '  AND (TP_MACHINE=''%s'')';
 
 begin
   With aData do
-    Result:=IDQuery(Format(SQLSelect,[VersionID,OSID,CPUID,CategoryID,Config]));
+    Result:=IDQuery(Format(SQLSelect,[VersionID,OSID,CPUID,CategoryID,Config,Machine]));
   if (Result=-1) and aAllowCreate then
     Result:=AddPlatform(aData)
 end;
 
+function TTestSQL.GetPlatformID(aVersionID, aOSID, aCPUID, aCategoryID: Integer; const aMachine, aConfig: String): Integer;
+var
+  TR : TTestRunData;
+begin
+  TR:=Default(TTestRunData);
+  TR.VersionID:=aVersionID;
+  TR.OSID:=aOSID;
+  TR.CPUID:=aCPUID;
+  TR.CategoryID:=aCategoryID;
+  TR.config:=aConfig;
+  TR.Machine:=aMachine;
+  Result:=GetPlatformID(TR,False);
+end;
+
+function TTestSQL.GetPlatformID(aRunID: Int64): Integer;
+Const
+  SFromID = 'SELECT TU_PLATFORM_FK FROM TESTRUN WHERE (TU_ID=%d)';
+begin
+  Result:=IDQuery(Format(SFromID,[aRunID]));
+end;
+
 function TTestSQL.GetCPUID(Name: String): Integer;
 
 Const
@@ -449,13 +583,23 @@ begin
   Result:=IDQuery(Format(SFromName,[Name]));
 end;
 
-function TTestSQL.GetCategoryID(Name: String): Integer;
+function TTestSQL.GetCPUName(aID: Integer): String;
+begin
+  Result:=StringQuery(Format('SELECT TC_NAME FROM TESTCPU WHERE (TC_ID=%d)',[aID]));
+end;
+
+function TTestSQL.GetCategoryID(aName: String): Integer;
 
 Const
   SFromName = 'SELECT TA_ID FROM TESTCATEGORY WHERE (TA_NAME=''%s'')';
 
 begin
-  Result:=IDQuery(Format(SFromName,[Name]));
+  Result:=IDQuery(Format(SFromName,[aName]));
+end;
+
+function TTestSQL.GetCategoryName(aID: Integer): String;
+begin
+  Result:=StringQuery(Format('SELECT TA_NAME FROM TESTCATEGORY WHERE (TA_ID=%d)',[aID]));
 end;
 
 function TTestSQL.GetRunID(aData: TTestRunData): Int64;
@@ -471,25 +615,179 @@ begin
     Result:=ID64Query(Format(SFromIDS,[PlatFormID,SQLDate(Date)]));
 end;
 
+function TTestSQL.GetRunData(aID: Int64; out aData: TTestRunData): Boolean;
+
+const
+  SQLSelectRUNData =
+             'select ' +
+             '  TA_NAME, TV_VERSION, TV_RELEASEDATE, TV_ID, TC_NAME, TO_NAME, TestPlatform.* , TESTRUN.* ' +
+             'from  ' +
+             '  TESTRUN  ' +
+             '  INNER JOIN TESTPLATFORM ON (TP_ID=TU_PLATFORM_FK) ' +
+             '  INNER JOIN TESTOS ON (TO_ID=TP_OS_FK) ' +
+             '  INNER JOIN TESTCPU ON (TC_ID=TP_CPU_FK) ' +
+             '  INNER JOIN TESTCATEGORY ON (TA_ID=TP_CATEGORY_FK) ' +
+             '  INNER JOIN TESTVERSION ON (TV_ID=TP_VERSION_FK) ' +
+             'WHERE (TU_ID=%d)';
+
+var
+  Qry : TSQLQuery;
+  ST : TTestStatus;
+
+begin
+  Qry:=CreateQuery(Format(SQLSelectRunData,[aID]));
+  try
+    Qry.Open;
+    Result:=Not Qry.IsEmpty;
+    if Result then
+      With Qry do
+        begin
+        aData.RunID:=aID;
+        aData.os:=FieldByName('TO_NAME').AsString;
+        aData.OSID:=FieldByName('TP_OS_FK').AsInteger;
+        aData.cpu:=FieldByName('TC_NAME').AsString;
+        aData.CPUID:=FieldByName('TP_CPU_FK').AsInteger;
+        aData.version:=FieldByName('TV_VERSION').AsString;
+        aData.versionID:=FieldByName('TV_ID').asInteger;
+        aData.category:=FieldByName('TA_NAME').AsString;
+        aData.PlatformID:=FieldByName('TP_ID').AsInteger;
+        aData.Config:=FieldByName('TP_CONFIG').AsString;
+        aData.Machine:=FieldByName('TP_MACHINE').AsString;
+        aData.submitter:=FieldByName('TU_SUBMITTER').AsString;
+        // aData.:=FieldByName('TV_RELEASEDATE').AsString;
+        aData.Date:=FieldByName('TU_DATE').AsDateTime;
+        aData.CompilerDate:=FieldByName('TU_COMPILERDATE').AsString;
+        aData.CompilerFullversion:=FieldByName('TU_COMPILERFULLVERSION').AsString;
+        aData.CompilerRevision:=FieldByName('TU_COMPILERREVISION').AsString;
+        aData.TestsRevision:=FieldByName('TU_TESTSREVISION').AsString;
+        aData.RTLRevision:=FieldByName('TU_RTLREVISION').AsString;
+        aData.PackagesRevision:=FieldByName('TU_PACKAGESREVISION').AsString;
+        for ST in TTestStatus do
+          aData.StatusCount[ST]:=FieldByName(SQLField[ST]).AsInteger;
+        end;
+  finally
+    Qry.Free;
+  end;
+end;
+
+function TTestSQL.GetLastRunByPlatformAndDate(aPLatformID: Integer; aDate: TDateTime): Integer;
+const
+  SQLSelect =
+    'select '+
+    '  TU_ID '+
+    'from '+
+    '  testrun '+
+    'where '+
+    '  (tu_platform_fk=%d) '+
+    '  and (tu_date<''%s'') '+
+    'order by '+
+    '  tu_date desc '+
+    'limit 1';
+begin
+  Result:=ID64Query(Format(SQLSelect,[aPlatformID,SQLDate(aDate)]));
+end;
+
+function TTestSQL.GetTestInfo(aID: Int64; out aInfo: TTestInfo): Boolean;
+
+  function splitID(aString : String) : TIntegerDynArray;
+  var
+    lArray : TStringDynArray;
+    i,count : integer;
+    S : string;
+  begin
+    Result:=[];
+    lArray:=aString.Split(',');
+    SetLength(Result,Length(lArray));
+    count:=0;
+    for S in lArray do
+      if TryStrToInt(Trim(S),i) then
+        begin
+        Result[Count]:=I;
+        inc(count);
+        end;
+    SetLength(Result,Count);
+  end;
+
+const
+  SQLSelect = 'SELECT * FROM TESTS WHERE (T_ID=%d)';
+
+var
+  Qry : TSQLQuery;
+
+begin
+  aInfo:=Default(TTestInfo);
+  Qry:=CreateQuery(Format(SQLSelect,[aID]));
+  try
+    Qry.Open;
+    Result:=Not Qry.IsEmpty;
+    if Not Result then
+      exit;
+
+    aInfo.Name:=Qry.FieldByname('T_Name').AsString;
+    aInfo.CPU:=Qry.FieldByname('T_CPU').AsString;
+    aInfo.OS:=Qry.FieldByname('T_OS').Asstring;
+    aInfo.Version:=Qry.FieldByname('T_VERSION').Asstring;
+    aInfo.AddDate:=Qry.FieldByname('T_ADDDATE').AsDateTime;
+    aInfo.Graph:=Qry.FieldByname('T_GRAPH').Asboolean;
+    aInfo.Interactive:=Qry.FieldByname('T_INTERACTIVE').Asboolean;
+    aInfo.Result:=Qry.FieldByname('T_RESULT').AsInteger;
+    aInfo.Fail:=Qry.FieldByname('T_FAIL').Asboolean;
+    aInfo.ReCompile:=Qry.FieldByname('T_RECOMPILE').Asboolean;
+    aInfo.NoRun:=Qry.FieldByname('T_NORUN').Asboolean;
+    aInfo.NeedLibrary:=Qry.FieldByname('T_NEEDLIBRARY').Asboolean;
+    aInfo.KnownRunError:=Qry.FieldByname('T_KNOWNRUNERROR').AsInteger;
+    aInfo.Known:=Qry.FieldByname('T_Known').Asboolean;
+    aInfo.Note:=Qry.FieldByname('T_NOTE').AsString;
+    aInfo.Description:=Qry.FieldByname('T_DESCRIPTION').AsString;
+    aInfo.Source:=Qry.FieldByname('T_SOURCE').AsString;
+    aInfo.Opts:=Qry.FieldByname('T_OPTS').AsString;
+    aInfo.DelOptions:=Qry.FieldByname('T_DELOPTS').AsString;
+    aInfo.SkipCPU:=Qry.FieldByname('T_SKIPCPU').AsString;
+    aInfo.SkipEmu:=Qry.FieldByname('T_SKIPEMU').AsString;
+    aInfo.NeedTarget:=Qry.FieldByname('T_NEEDTARGET').AsString;
+    aInfo.SkipTarget:=Qry.FieldByname('T_SKIPTARGET').AsString;
+    aInfo.MaxVersion:=Qry.FieldByname('T_MAXVERSION').AsString;
+    aInfo.KnownRunNote:=Qry.FieldByname('T_KNOWNRUNNOTE').AsString;
+    aInfo.KnownCompileNote:=Qry.FieldByname('T_KNOWNCOMPILENOTE').AsString;
+    aInfo.RecompileOpt:=Qry.FieldByname('T_RECOMPILEOPT').AsString;
+    aInfo.KnownCompileError:=Qry.FieldByname('T_KNOWNCOMPILEERROR').AsInteger;
+    aInfo.NeededAfter:=Qry.FieldByname('T_NEEDEDAFTER').AsBoolean;
+    aInfo.IsKnownRunError:=Qry.FieldByname('T_ISKNOWNRUNERROR').AsBoolean;
+    aInfo.Timeout:=Qry.FieldByname('T_TIMEOUT').AsInteger;
+    aInfo.Category:=Qry.FieldByname('T_CATEGORY').AsString;
+    aInfo.Files:=Qry.FieldByname('T_FILES').AsString;
+    aInfo.ConfigFileSrc:=Qry.FieldByname('T_CONFIGFILESRC').AsString;
+    aInfo.ConfigFileDst:=Qry.FieldByname('T_CONFIGFILEDST').AsString;
+    aInfo.WpoParas:=Qry.FieldByname('T_WPOPARAS').AsString;
+    aInfo.WpoPasses:=Qry.FieldByname('T_WPOPASSES').AsInteger;
+    aInfo.DelFiles:=Qry.FieldByname('T_DELFILES').AsString;
+    aInfo.ExpectMsgs:=SplitID(Qry.FieldByname('T_EXPECTMSGS').AsString);
+
+  finally
+    Qry.Free;
+  end;
+end;
+
 function TTestSQL.AddRun(const aData : TTestRunData): Int64;
 
 Const
   SInsertRun = 'INSERT INTO TESTRUN '+
-               '(TU_PLATFORM_FK, TU_MACHINE, TU_SUBMITTER, TU_DATE, '+
+               '(TU_PLATFORM_FK, TU_SUBMITTER, TU_DATE, '+
                ' TU_COMPILERDATE, TU_COMPILERFULLVERSION, TU_COMPILERREVISION, '+
                ' TU_TESTSREVISION, TU_RTLREVISION, TU_PACKAGESREVISION  )'+
                ' VALUES '+
-               '(%d,''%s'',''%s'',''%s'', '+
+               '(%d,''%s'',''%s'', '+
                ' ''%s'',''%s'',''%s'', '+
                ' ''%s'',''%s'',''%s'' '+
                ') RETURNING TU_ID';
 
 var
   Qry : string;
+  PreviousID : Int64;
+
 begin
   With aData do
     qry:=Format(SInsertRun,[PlatformID,
-                            EscapeSQL(Machine),
                             EscapeSQL(Submitter),
                             SQLDate(Date),
                             EscapeSQL(CompilerDate),
@@ -499,9 +797,32 @@ begin
                             EscapeSQL(RTLRevision),
                             EscapeSQL(PackagesRevision)]);
   Result:=IDQuery(Qry);
+  PreviousID:=GetLastRunByPlatformAndDate(aData.PlatformID,aData.Date);
+  if PreviousID<>-1 then
+    InsertTestHistory(Result,PreviousID);
 end;
 
 
+function TTestSQL.InsertTestHistory(TestRunID,TestPreviousID : Integer) : boolean;
+
+const
+  SQLInsert = 'INSERT INTO TESTRUNHISTORY '+
+              '  (TH_ID_FK,TH_PREVIOUS_FK) '+
+              'VALUES '+
+              '  (%d,%d) '+
+              'ON CONFLICT (TH_ID_FK) '+
+              'DO UPDATE SET '+
+              '  TH_PREVIOUS_FK=EXCLUDED.TH_PREVIOUS_FK';
+var
+  qry : string;
+
+begin
+  Qry:=format(SQLInsert,[TestRunID,TestPreviousID]);
+  Result:=ExecuteQuery(Qry,False);
+end;
+
+
+
 
 function TTestSQL.AddTest(Name: String; AddSource: Boolean): Integer;
 
@@ -529,7 +850,7 @@ begin
      or GetUnitTestConfig(logprefix,Name,lSrcDir,Info) then
     begin
     If AddSource then
-      UpdateTest(Result,Info,testu.GetFileContents(Name))
+      UpdateTest(Result,Info,tsutils.GetFileContents(Name))
     else
       UpdateTest(Result,Info,'');
     end
@@ -538,38 +859,89 @@ begin
 end;
 
 
-function TTestSQL.UpdateTest(ID: Integer; Info: TConfig; Source: String): Boolean;
+function TTestSQL.UpdateTest(ID: Integer; Info: TConfig; const Source: String): Boolean;
 
 Const
-  SUpdateTest = 'Update TESTS SET '+
-                ' T_CPU=''%s'', T_OS=''%s'', T_VERSION=''%s'','+
-                ' T_GRAPH=''%s'', T_INTERACTIVE=''%s'', T_RESULT=%d,'+
-                ' T_FAIL=''%s'', T_RECOMPILE=''%s'', T_NORUN=''%s'','+
-                ' T_NEEDLIBRARY=''%s'', T_KNOWNRUNERROR=%d,'+
-                ' T_KNOWN=''%s'', T_NOTE=''%s'', T_OPTS = ''%s'''+
-                ' %s '+
-                'WHERE'+
-                ' T_ID=%d';
+  SQLUpdateTest = 'Update TESTS SET '+
+                  ' %s '+
+                  'WHERE'+
+                  ' (T_ID=%d)';
+
+  function JoinIDS(IDS: Array of Integer) : string;
+  var
+    S : String;
+    I : Integer;
+  begin
+    S:='';
+    For I:=0 to Length(IDS)-1 do
+      begin
+      if I>0 then
+        S:=S+',';
+      S:=S+IntToStr(IDS[i]);
+      end;
+    Result:=S;
+  end;
 
+  procedure AddField(var S : String; const aName,aValue : String);
+  begin
+    if S<>'' then
+      S:=S+', ';
+    S:=S+Format('%s = ''%s''',[aName,EscapeSQl(aValue)])
+  end;
+  procedure AddField(var S : String; const aName : String; aValue : Integer);
+  begin
+    if S<>'' then
+      S:=S+', ';
+    S:=S+Format('%s = %d',[aName,aValue])
+  end;
 
 Var
-  Qry : String;
+  Qry :  String;
 
 begin
-  If Source<>'' then
+  Qry:='';
+  With Info do
     begin
-    Source:=EscapeSQL(Source);
-    Source:=', T_SOURCE='''+Source+'''';
+    AddField(Qry,'T_CPU',NeedCPU);
+    AddField(Qry,'T_OS',OS);
+    AddField(Qry,'T_VERSION',MinVersion);
+    AddField(Qry,'T_GRAPH',Bools[usesGraph]);
+    AddField(Qry,'T_INTERACTIVE',Bools[IsInteractive]);
+    AddField(Qry,'T_RESULT',ResultCode);
+    AddField(Qry,'T_FAIL',Bools[ShouldFail]);
+    AddField(Qry,'T_RECOMPILE',Bools[NeedRecompile]);
+    AddField(Qry,'T_NORUN',Bools[NoRun]);
+    AddField(Qry,'T_DESCRIPTION',Description);
+    AddField(Qry,'T_NEEDLIBRARY',Bools[NeedLibrary]);
+    AddField(Qry,'T_KNOWNRUNERROR',KnownRunError);
+    AddField(Qry,'T_KNOWN',Bools[IsKnownCompileError]);
+    AddField(Qry,'T_Note',Note);
+    AddField(Qry,'T_OPTS',NeedOptions);
+    AddField(Qry,'T_DELOPTS',DelOptions);
+    AddField(Qry,'T_SKIPCPU',SkipCPU);
+    AddField(Qry,'T_SKIPEMU',SkipEmu);
+    AddField(Qry,'T_NEEDTARGET',NeedTarget);
+    AddField(Qry,'T_SKIPTARGET',SkipTarget);
+    AddField(Qry,'T_MAXVERSION',MaxVersion);
+    AddField(Qry,'T_KNOWNRUNNOTE',KnownRunNote);
+    AddField(Qry,'T_KNOWNCOMPILENOTE',KnownCompileNote);
+    AddField(Qry,'T_RECOMPILEOPT',RecompileOpt);
+    AddField(Qry,'T_KNOWNCOMPILEERROR',KnownCompileError);
+    AddField(Qry,'T_NEEDEDAFTER',Bools[NeededAfter]);
+    AddField(Qry,'T_ISKNOWNRUNERROR',Bools[IsKnownRunError]);
+    AddField(Qry,'T_TIMEOUT', Timeout);
+    AddField(Qry,'T_CATEGORY',Category);
+    AddField(Qry,'T_FILES',Files);
+    AddField(Qry,'T_CONFIGFILESRC',ConfigFileSrc);
+    AddField(Qry,'T_CONFIGFILEDST',ConfigFileDst);
+    AddField(Qry,'T_WPOPARAS',WpoParas);
+    AddField(Qry,'T_WPOPASSES',WpoPasses);
+    AddField(Qry,'T_DELFILES',DelFiles);
+    AddField(Qry,'T_EXPECTMSGS',JoinIDS(ExpectMsgs));
+    If (Source<>'') then
+      AddField(Qry,'T_SOURCE',Source);
     end;
-  With Info do
-    Qry:=Format(SUpdateTest,[EscapeSQL(NeedCPU),'',EscapeSQL(MinVersion),
-                             Bools[usesGraph],Bools[IsInteractive],ResultCode,
-                             Bools[ShouldFail],Bools[NeedRecompile],Bools[NoRun],
-                             Bools[NeedLibrary],KnownRunError,
-                             Bools[IsKnownCompileError],EscapeSQL(Note),EscapeSQL(NeedOptions),
-                             Source,
-                             ID
-     ]);
+  Qry:=Format(SQLUpdateTest,[Qry,ID]);
   Result:=ExecuteQuery(Qry,False);
 end;
 
@@ -667,6 +1039,16 @@ begin
 
 end;
 
+function TTestSQL.GetFailCount(aRunID: Int64): Int64;
+const
+  SQLSelectFailCount =
+               'SELECT (TU_FAILEDTOCOMPILE + TU_FAILEDTOFAIL + TU_FAILEDTORUN) as thecount '+
+              ' FROM TESTRUN WHERE (TU_ID=%d)';
+
+begin
+  Result:=ID64Query(Format(SQLSelectFailCount,[aRunID]));
+end;
+
 function TTestSQL.AddLastResult(TestID, PlatformID: Integer; ResultID: Int64) : Boolean;
 
 const
@@ -716,14 +1098,19 @@ begin
   Result:=True;
 end;
 
-function TTestSQL.RequireTestID(Name: String): Integer;
+function TTestSQL.GetFailCount(aRunID: Integer): Int64;
+begin
+  Result:=ID64Query(Format('SELECT (TU_FAILEDTOCOMPILE + TU_FAILEDTOFAIL + TU_FAILEDTORUN) FROM TESTRUN WHERE (TU_ID=%d)',[aRunID]));
+end;
+
+function TTestSQL.RequireTestID(const aName: String): Integer;
 
 begin
-  Result:=GetTestID(Name);
+  Result:=GetTestID(aName);
   If Result=-1 then
-    Result:=AddTest(Name,True);
+    Result:=AddTest(aName,True);
   If Result=-1 then
-    Verbose(V_WARNING,'Could not find or create entry for test '+Name);
+    Verbose(V_WARNING,'Could not find or create entry for test '+aName);
 end;
 
 function TTestSQL.CleanTestRun(ID: Integer): Boolean;
@@ -735,5 +1122,17 @@ begin
   Result:=ExecuteQuery(Format(SDeleteRun,[ID]),False);
 end;
 
+function TTestSQL.GetPreviousRunID(RunID: Int64): Int64;
+
+begin
+  Result:=ID64Query(Format('SELECT TH_PREVIOUS_FK FROM TESTRUNHISTORY WHERE (TH_ID_FK=%d)',[RunID]));
+end;
+
+function TTestSQL.GetNextRunID(RunID: Int64): Int64;
+
+begin
+  Result:=ID64Query(Format('SELECT TH_ID_FK FROM TESTRUNHISTORY WHERE (TH_PREVIOUS_FK=%d)',[RunID]));
+end;
+
 
 end.

tests/utils/teststr.pp → tests/utils/tsstring.pp

@@ -15,10 +15,13 @@
 
  **********************************************************************}
 
-unit teststr;
+unit tsstring;
 
 interface
 
+const
+  Bools : Array[Boolean] of string = ('f','t');
+
 const
   failed_to_compile = 'Failed to compile ';
   success_compilation_failed = 'Success, compilation failed ';

tests/utils/tstypes.pp

@@ -0,0 +1,368 @@
+{
+    This file is part of the Free Pascal test suite.
+    Copyright (c) 2007 by the Free Pascal development team.
+
+    This unit contains the different possible outcome
+    of a single test.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$h+}
+
+unit tstypes;
+
+interface
+
+uses
+  tsstring;
+
+
+Type
+  TTestStatus = (
+  stFailedToCompile,
+  stSuccessCompilationFailed,
+  stFailedCompilationsuccessful,
+  stSuccessfullyCompiled,
+  stFailedToRun,
+  stKnownRunProblem,
+  stSuccessFullyRun,
+  stSkippingGraphTest,
+  stSkippingInteractiveTest,
+  stSkippingKnownBug,
+  stSkippingCompilerVersionTooLow,
+  stSkippingCompilerVersionTooHigh,
+  stSkippingOtherCpu,
+  stSkippingOtherTarget,
+  stskippingRunUnit,
+  stskippingRunTest
+  );
+
+
+Const
+  FirstStatus = stFailedToCompile;
+  LastStatus = stskippingRunTest;
+
+  TestOK : Array[TTestStatus] of Boolean = (
+    False, // stFailedToCompile,
+    True,  // stSuccessCompilationFailed,
+    False, // stFailedCompilationsuccessful,
+    True,  // stSuccessfullyCompiled,
+    False, // stFailedToRun,
+    True,  // stKnownRunProblem,
+    True,  // stSuccessFullyRun,
+    False, // stSkippingGraphTest,
+    False, // stSkippingInteractiveTest,
+    False, // stSkippingKnownBug,
+    False, // stSkippingCompilerVersionTooLow,
+    False, // stSkippingCompilerVersionTooHigh,
+    False, // stSkippingOtherCpu,
+    False, // stSkippingOtherTarget,
+    False, // stskippingRunUnit,
+    False  // stskippingRunTest
+  );
+
+  TestSkipped : Array[TTestStatus] of Boolean = (
+    False,  // stFailedToCompile,
+    False,  // stSuccessCompilationFailed,
+    False,  // stFailedCompilationsuccessful,
+    False,  // stSuccessfullyCompiled,
+    False,  // stFailedToRun,
+    False,  // stKnownRunProblem,
+    False,  // stSuccessFullyRun,
+    True,   // stSkippingGraphTest,
+    True,   // stSkippingInteractiveTest,
+    True,   // stSkippingKnownBug,
+    True,   // stSkippingCompilerVersionTooLow,
+    True,   // stSkippingCompilerVersionTooHigh,
+    True,   // stSkippingOtherCpu,
+    True,   // stSkippingOtherTarget,
+    True,   // stskippingRunUnit,
+    True    // stskippingRunTest
+  );
+
+  ExpectRun : Array[TTestStatus] of Boolean = (
+    False,  // stFailedToCompile,
+    False,  // stSuccessCompilationFailed,
+    False,  // stFailedCompilationsuccessful,
+    True ,  // stSuccessfullyCompiled,
+    False,  // stFailedToRun,
+    False,  // stKnownRunProblem,
+    False,  // stSuccessFullyRun,
+    False,  // stSkippingGraphTest,
+    False,  // stSkippingInteractiveTest,
+    False,  // stSkippingKnownBug,
+    False,  // stSkippingCompilerVersionTooLow,
+    False,  // stSkippingCompilerVersionTooHigh,
+    False,  // stSkippingOtherCpu,
+    False,  // stSkippingOtherTarget,
+    False,  // stskippingRunUnit,
+    False   // stskippingRunTest
+   );
+
+  StatusText : Array[TTestStatus] of String = (
+    failed_to_compile,
+    success_compilation_failed,
+    failed_compilation_successful ,
+    successfully_compiled ,
+    failed_to_run ,
+    known_problem ,
+    successfully_run ,
+    skipping_graph_test ,
+    skipping_interactive_test ,
+    skipping_known_bug ,
+    skipping_compiler_version_too_low,
+    skipping_compiler_version_too_high,
+    skipping_other_cpu ,
+    skipping_other_target ,
+    skipping_run_unit ,
+    skipping_run_test
+  );
+
+  SQLField : Array[TTestStatus] of String = (
+    'TU_FAILEDTOCOMPILE',
+    'TU_SUCCESSFULLYFAILED',
+    'TU_FAILEDTOFAIL',
+    'TU_SUCCESFULLYCOMPILED',
+    'TU_FAILEDTORUN',
+    'TU_KNOWNPROBLEM',
+    'TU_SUCCESSFULLYRUN',
+    'TU_SKIPPEDGRAPHTEST',
+    'TU_SKIPPEDINTERACTIVETEST',
+    'TU_KNOWNBUG',
+    'TU_COMPILERVERIONTOOLOW',
+    'TU_COMPILERVERIONTOOHIGH',
+    'TU_OTHERCPU',
+    'TU_OTHERTARGET',
+    'TU_UNIT',
+    'TU_SKIPPINGRUNTEST'
+  );
+
+
+  UseGit = True;
+
+  faction_show_overview = 0;
+  faction_show_run_results = 1;
+  faction_show_run_pie = 2;
+  faction_show_one_test = 3;
+  faction_show_history = 4;
+  faction_compare_with_previous = 5;
+  faction_compare_with_next = 6;
+  faction_compare2_with_previous = 7;
+  faction_compare2_with_next = 8;
+  faction_compare_both_with_previous = 9;
+  faction_compare_both_with_next = 10;
+
+Type
+  TCharSet = set of char;
+
+  TVerboseLevel=(V_Abort,V_Error,V_Warning,V_Normal,V_Debug,V_SQL);
+
+  // This record contains exactly the fields of the database.
+
+  TTestInfo = record
+    Name : String;
+    CPU : String;
+    OS : string;
+    Version : string;
+    AddDate : TDateTime;
+    Graph : boolean;
+    Interactive : boolean;
+    Result :  integer;
+    Fail : boolean;
+    ReCompile : boolean;
+    NoRun : boolean;
+    NeedLibrary : boolean;
+    KnownRunError : Integer;
+    Known : boolean;
+    Note : String;
+    Description : String;
+    Source : String;
+    Opts : String;
+    DelOptions,
+    SkipCPU,
+    SkipEmu,
+    NeedTarget,
+    SkipTarget,
+    MaxVersion,
+    KnownRunNote,
+    KnownCompileNote,
+    RecompileOpt: string;
+    KnownCompileError : longint;
+    NeededAfter   : boolean;
+    IsKnownRunError : Boolean;
+    Timeout       : longint;
+    Category      : string;
+    Files         : string;
+    ConfigFileSrc : string;
+    ConfigFileDst : string;
+    WpoParas      : string;
+    WpoPasses     : longint;
+    DelFiles      : string;
+    ExpectMsgs    : array of longint;
+    Property NeedCPU : String Read CPU Write CPU;
+    Property MinVersion : String Read Version Write Version;
+    Property UsesGraph : boolean read Graph Write Graph;
+    Property IsInteractive : boolean Read Interactive write INTERACTIVE;
+    Property ResultCode : Integer Read RESULT Write RESULT;
+    Property ShouldFail : Boolean Read FAIL Write Fail;
+    Property NeedRecompile : Boolean Read Recompile Write Recompile;
+    Property IsKnownCompileError : Boolean read KNOWN Write KNown;
+    Property NeedOptions : String Read OPTS Write OPTS;
+  end;
+  TConfig = TTestInfo;
+
+  TRunStats = Record
+    OKCount,
+    FailedCount,
+    SkipCount : Integer;
+  end;
+
+  // Test run data
+
+  { TTestRunData }
+
+  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;
+    Function GetField(const aField : String) : String;
+    function FailedCount: Integer;
+    function OKCount: Integer;
+    function TotalCount: 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;
+
+implementation
+
+uses sysutils;
+
+{ TTestRunData }
+
+function TTestRunData.OKCount : Integer;
+begin
+  Result:=StatusCount[stSuccessCompilationFailed] +
+          StatusCount[stSUCCESSFULLYCOMPILED] +
+          StatusCount[stSUCCESSFULLYRUN]
+end;
+
+
+function TTestRunData.FailedCount : Integer;
+
+begin
+  Result:=StatusCount[stFAILEDTOCOMPILE] +
+          StatusCount[stFAILEDTORUN] +
+          StatusCount[stFailedCompilationsuccessful];
+end;
+
+function TTestRunData.TotalCount: Integer;
+begin
+  Result:=OKCount+FailedCount;
+end;
+
+
+function TTestRunData.GetField(const aField: String): String;
+begin
+  case lowercase(aField) of
+  'logfile' : Result:=logfile;
+  'longlogfile ' : Result:=longlogfile ;
+  'os' : Result:=os;
+  'cpu' : Result:=cpu;
+  'category' : Result:=category;
+  'version' : Result:=version;
+  'submitter' : Result:=submitter;
+  'machine' : Result:=machine;
+  'comment',
+  'config ' : Result:=config ;
+  'description ' : Result:=description ;
+  'date ' : Result:=DateToStr(Date);
+  'compilerdate': Result:=CompilerDate;
+  'compilerfullversion': Result:=CompilerFullVersion;
+  'compilerrevision':  Result:=CompilerRevision;
+  'restsrevision': Result:=TestsRevision;
+  'rtlrevision': Result:=RTLRevision;
+  'packagesrevision' : Result:=PackagesRevision ;
+  'cpuid' : Result:=IntToStr(CPUID);
+  'osid' : Result:=IntToStr(OSID);
+  'versionid' : Result:=IntToStr(VersionID);
+  'categoryid' : Result:=IntToStr(CategoryID);
+  'runid' : Result:=IntToStr(RunID);
+  'platformid': Result:=IntToStr(PlatformID);
+  'stfailedtocompile' : Result:=IntToStr(StatusCount[stfailedtocompile]);
+  'stsuccesscompilationfailed' : Result:=IntToStr(StatusCount[stsuccesscompilationfailed]);
+  'stfailedcompilationsuccessful' : Result:=IntToStr(StatusCount[stfailedcompilationsuccessful]);
+  'stsuccessfullycompiled' : Result:=IntToStr(StatusCount[stsuccessfullycompiled]);
+  'stfailedtorun' : Result:=IntToStr(StatusCount[stfailedtorun]);
+  'stknownrunproblem' : Result:=IntToStr(StatusCount[stknownrunproblem]);
+  'stsuccessfullyrun' : Result:=IntToStr(StatusCount[stsuccessfullyrun]);
+  'stskippinggraphtest' : Result:=IntToStr(StatusCount[stskippinggraphtest]);
+  'stskippinginteractivetest' : Result:=IntToStr(StatusCount[stskippinginteractivetest]);
+  'stskippingknownbug' : Result:=IntToStr(StatusCount[stskippingknownbug]);
+  'stskippingcompilerversiontoolow' : Result:=IntToStr(StatusCount[stskippingcompilerversiontoolow]);
+  'stskippingcompilerversiontoohigh' : Result:=IntToStr(StatusCount[stskippingcompilerversiontoohigh]);
+  'stskippingothercpu' : Result:=IntToStr(StatusCount[stskippingothercpu]);
+  'stskippingothertarget' : Result:=IntToStr(StatusCount[stskippingothertarget]);
+  'stskippingrununit' : Result:=IntToStr(StatusCount[stskippingrununit]);
+  'stskippingruntest' : Result:=IntToStr(StatusCount[stskippingruntest]);
+  'failed' :  Result:=IntToStr(FailedCount);
+  'ok' : Result:=IntToStr(OKCount);
+  'total' : Result:=IntToStr(TotalCount);
+  'rev' : Result:=CompilerRevision+'/'+RTLRevision+'/'+PackagesRevision+'/'+TestsRevision;
+  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/tsutils.pp

@@ -0,0 +1,506 @@
+{ ---------------------------------------------------------------------
+    utility functions, shared by several programs of the test suite
+  ---------------------------------------------------------------------}
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$h+}
+
+unit tsutils;
+
+Interface
+
+uses
+  classes, sysutils, tstypes;
+
+Type
+  TOnVerboseEvent = procedure(lvl:TVerboseLevel; const aMsg : String) of object;
+
+var
+  OnVerbose : TOnVerboseEvent = Nil;
+  IsCGI : boolean = false;
+  DoVerbose : boolean = false;
+  DoSQL     : boolean = false;
+  MaxLogSize : LongInt = 50000;
+
+
+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 logprefix,fn:string;out aConfig:TConfig):boolean;
+function GetUnitTestConfig(const logprefix,fn,SrcDir: string; out aConfig : TConfig) : Boolean;
+Function GetFileContents (FN : String) : String;
+
+const
+{ Constants used in IsAbsolute function }
+  TargetHasDosStyleDirectories : boolean = false;
+  TargetAmigaLike : boolean = false;
+  TargetIsMacOS : boolean = false;
+  TargetIsUnix : boolean = false;
+
+{ File path helper functions }
+function SplitPath(const s:string):string;
+function SplitBasePath(const s:string): string;
+Function SplitFileName(const s:string):string;
+Function SplitFileBase(const s:string):string;
+Function SplitFileExt(const s:string):string;
+Function FileExists (Const F : String) : Boolean;
+Function PathExists (Const F : String) : Boolean;
+Function IsAbsolute (Const F : String) : boolean;
+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;
+  p: PChar;
+begin
+  p:=PChar(s);
+  i:=0;
+  while (p^ <> #0) and not (p^ in Delims) do begin
+    Inc(p);
+    Inc(i);
+  end;
+  GetToken:=Copy(s,1,i);
+  Delete(s,1,i+1);
+end;
+
+function SplitPath(const s:string):string;
+var
+  i : longint;
+begin
+  i:=Length(s);
+  while (i>0) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
+   dec(i);
+  SplitPath:=Copy(s,1,i);
+end;
+
+
+function SplitBasePath(const s:string): string;
+var
+  i : longint;
+begin
+  i:=1;
+  while (i<length(s)) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
+   inc(i);
+  if s[i] in  ['/','\'{$IFDEF MACOS},':'{$ENDIF}] then
+    dec(i);
+  SplitBasePath:=Copy(s,1,i);
+end;
+
+Function SplitFileName(const s:string):string;
+
+begin
+  Result:=ExtractFileName(S);
+end;
+
+Function SplitFileBase(const s:string):string;
+
+begin
+  Result:=ChangeFileExt(ExtractFileName(S),'');
+end;
+
+Function SplitFileExt(const s:string):string;
+begin
+  Result:=ExtractFileExt(S);
+end;
+
+
+Function FileExists (Const F : String) : Boolean;
+
+begin
+  Result:=SysUtils.FileExists(F);
+end;
+
+
+Function PathExists (Const F : String) : Boolean;
+{
+  Returns True if the file exists, False if not.
+}
+
+begin
+  Result:=DirectoryExists(F);
+end;
+
+{ extracted from rtl/macos/macutils.inc }
+
+function IsMacFullPath (const path: string): Boolean;
+  begin
+    if Pos(':', path) = 0 then    {its partial}
+      IsMacFullPath := false
+    else if path[1] = ':' then
+      IsMacFullPath := false
+    else
+      IsMacFullPath := true
+  end;
+
+
+Function IsAbsolute (Const F : String) : boolean;
+{
+  Returns True if the name F is a absolute file name
+}
+begin
+  IsAbsolute:=false;
+  if TargetHasDosStyleDirectories then
+    begin
+      if (F[1]='/') or (F[1]='\') then
+        IsAbsolute:=true;
+      if (Length(F)>2) and (F[2]=':') and ((F[3]='\') or (F[3]='/')) then
+        IsAbsolute:=true;
+    end
+  else if TargetAmigaLike then
+    begin
+      if (length(F)>0) and (Pos(':',F) <> 0) then
+        IsAbsolute:=true;
+    end
+  else if TargetIsMacOS then
+    begin
+      IsAbsolute:=IsMacFullPath(F);
+    end
+  { generic case }
+  else if (F[1]='/') then
+    IsAbsolute:=true;
+end;
+
+procedure Verbose(lvl:TVerboseLevel;const s:string);
+
+const
+  lPrefixes : Array[TVerboseLevel] of string = ('Abort','Error','Warning','Info','Debug','SQL');
+
+var
+  lOutput : String;
+
+  Procedure DoOutput;
+
+  begin
+    if not IsCGI then
+      begin
+      Writeln(output,lOutput);
+      Flush(output);
+      end
+    else
+      begin
+      Writeln(stderr,lOutput);
+      Flush(stderr);
+      end;
+    if Assigned(OnVerbose) then
+      OnVerbose(lvl,lOutput);
+  end;
+
+begin
+  lOutput:=lPrefixes[lvl]+': '+S;
+  case lvl of
+    V_Normal :
+      DoOutput;
+    V_Debug :
+      if DoVerbose then
+        DoOutput;
+    V_SQL :
+      if DoSQL then
+        DoOutput;
+    V_Warning :
+      DoOutput;
+    V_Error :
+      begin
+        DoOutput;
+        if not IsCGI then
+          halt(1);
+      end;
+    V_Abort :
+      begin
+        DoOutput;
+        if not IsCGI then
+          halt(0);
+      end;
+  end;
+
+end;
+
+procedure TrimB(var s:string);
+begin
+  S:=TrimLeft(S);
+end;
+
+
+procedure TrimE(var s:string);
+begin
+  S:=TrimRight(S);
+end;
+
+
+function upper(const s : string) : string;
+var
+  i,l  : longint;
+
+begin
+  Result:='';
+  L:=Length(S);
+  SetLength(Result,l);
+  for i:=1 to l do
+    if s[i] in ['a'..'z'] then
+     Result[i]:=char(byte(s[i])-32)
+    else
+     Result[i]:=s[i];
+end;
+
+function GetConfig(const logprefix,fn:string;out aConfig:TConfig):boolean;
+
+  Procedure ExtractCodeAndNote(s : String; out aCode : Integer; out aNote : String);
+
+  var
+    i : Integer;
+
+  begin
+    aCode:=0;
+    aNote:='';
+    if S='' then
+      exit;
+    I:=1;
+    While (i<=Length(s)) and (S[I] in ['0'..'9']) do
+      Inc(i);
+    if I>1 then
+      aCode:=StrToIntDef(Copy(S,1,i-1),0);
+    aNote:=Copy(S,I,Length(S)-I+1);
+  end;
+
+  function GetEntry(S : String; Out entry, Res :string):boolean;
+  var
+    i : longint;
+
+  begin
+    Result:=False;
+    Entry:='';
+    Res:='';
+    S:=TrimLeft(s);
+    if (s='') or (S[1]<>'{') then exit(False);
+    Delete(S,1,1);
+    S:=TrimLeft(s);
+    if (s='') or (S[1]<>'%') then exit(False);
+    Delete(S,1,1);
+    S:=TrimLeft(s);
+    i:=Pos('}',S);
+    if I=0 then exit(False);
+    S:=Copy(S,1,I-1);
+    i:=Pos('=',S);
+    if I=0 then
+      Entry:=Trim(S)
+    else
+      begin
+      Entry:=Trim(Copy(S,1,I-1));
+      Res:=Trim(Copy(S,I+1,Length(S)-I));
+      end;
+    Result:=True;
+    Verbose(V_Debug,'Config: '+Entry+' = "'+Res+'"');
+  end;
+
+  Procedure AnalyseEntry(aEntry,aValue : string);
+  var
+    l,p,code : Integer;
+
+  begin
+    case UpperCase(aEntry) of
+      'OPT': aConfig.NeedOptions:=aValue;
+      'DELOPT': aConfig.DelOptions:=aValue;
+      'TARGET': aConfig.NeedTarget:=aValue;
+      'SKIPTARGET': aConfig.SkipTarget:=aValue;
+      'CPU': aConfig.NeedCPU:=aValue;
+      'SKIPCPU': aConfig.SkipCPU:=aValue;
+      'SKIPEMU': aConfig.SkipEmu:=aValue;
+      'VERSION': aConfig.MinVersion:=aValue;
+      'MAXVERSION': aConfig.MaxVersion:=aValue;
+      'RESULT' : aConfig.ResultCode:=StrToIntDef(aValue,0);
+      'GRAPH' : aConfig.UsesGraph:=true;
+      'FAIL' : aConfig.ShouldFail:=true;
+      'NORUN': aConfig.NoRun:=true;
+      'NEEDLIBRARY': aConfig.NeedLibrary:=true;
+      'NEEDEDAFTER': aConfig.NeededAfter:=true;
+      'TIMEOUT': aConfig.Timeout:=StrToIntDef(aValue,0);
+      'FILES': aConfig.Files:=aValue;
+      'WPOPARAS': aConfig.wpoparas:=aValue;
+      'WPOPASSES': aConfig.wpopasses:=StrToIntDef(aValue,0);
+      'DELFILES': aConfig.DelFiles:=aValue;
+      'INTERACTIVE': aConfig.IsInteractive:=true;
+      'RECOMPILE':
+         begin
+         aConfig.NeedRecompile:=true;
+         aConfig.RecompileOpt:=aValue;
+         end;
+      'KNOWNRUNERROR':
+         begin
+         aConfig.IsKnownRunError:=true;
+         ExtractCodeAndNote(aValue,aConfig.KnownRunError,aConfig.KnownRunNote);
+         end;
+      'KNOWNCOMPILEERROR':
+         begin
+         aConfig.IsKnownCompileError:=true;
+         ExtractCodeAndNote(aValue,aConfig.KnownCompileError,aConfig.KnownCompileNote);
+         end;
+      'NOTE':
+         begin
+         aConfig.Note:=aValue;
+         Verbose(V_Normal,LogPrefix+aConfig.Note);
+         end;
+      'CONFIGFILE':
+         begin
+         l:=Pos(' ',aValue);
+         if l>0 then
+           begin
+             aConfig.ConfigFileSrc:=Trim(Copy(aValue,1,l-1));
+             aConfig.ConfigFileDst:=Trim(Copy(aValue,l+1,Length(aValue)-l+1));
+             if aConfig.ConfigFileSrc='' then
+               Verbose(V_Error,LogPrefix+'Config file source is empty');
+             if aConfig.ConfigFileDst='' then
+               Verbose(V_Error,LogPrefix+'Config file destination is empty');
+           end
+         else
+           begin
+             aConfig.ConfigFileSrc:=aValue;
+             aConfig.ConfigFileDst:=aValue;
+           end;
+         end;
+      'EXPECTMSGS':
+         begin
+           p:=Pos(',',aValue);
+           while p>0 do
+             begin
+               val(Copy(aValue,1,p-1),l,code);
+               if code<>0 then
+                 Verbose(V_Error,LogPrefix+'Invalid value in EXPECTMSGS list: '+Copy(aValue,1,p-1));
+               Insert(l,aConfig.ExpectMsgs,Length(aConfig.ExpectMsgs));
+               Delete(aValue,1,p);
+               p:=Pos(',',aValue);
+             end;
+           Val(aValue,l,code);
+           if code<>0 then
+             Verbose(V_Error,LogPrefix+'Invalid value in EXPECTMSGS list: '+aValue);
+           Insert(l,aConfig.ExpectMsgs,Length(aConfig.ExpectMsgs));
+         end;
+       else
+         Verbose(V_Error,LogPrefix+'Unknown entry: '+aEntry+' with value: '+aValue);
+    end;
+  end;
+
+var
+  l : TStringList;
+  lErr : longint;
+  s,aEntry,aValue: string;
+
+begin
+  Result:=False;
+  aConfig:=Default(TConfig);
+  GetConfig:=false;
+  Verbose(V_Debug,LogPrefix+'Reading '+fn);
+  lErr:=0;
+  L:=TStringList.Create;
+  try
+    try
+      L.LoadFromFile(FN);
+    except
+      on E : Exception do
+        begin
+        Verbose(V_WARNING,'Error '+E.ClassName+' loading '+fn+': '+E.Message);
+        exit;
+        end;
+    end;
+    For S in L do
+      begin
+      if GetEntry(S,aEntry,aValue) then
+        AnalyseEntry(aEntry,aValue)
+      else
+        Inc(lErr);
+      if lErr>2 then
+         Break;
+      end;
+  finally
+    L.Free;
+  end;
+  Result:=true;
+end;
+
+Function GetFileContents (FN : String) : String;
+
+begin
+  Result:=Sysutils.GetFileAsString(FN);
+end;
+
+function GetUnitTestConfig(const logprefix,fn,SrcDir : string; out aConfig : TConfig) : Boolean;
+
+var
+  Path       : string;
+  lClassName  : string;
+  lMethodName : string;
+  slashpos   : integer;
+  FileName   : string;
+  s,line     : string;
+  Src : TStrings;
+
+begin
+  Result := False;
+  aConfig:=Default(TConfig);
+  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;
+                 aConfig.Note:= 'unittest';
+               end;
+            end;
+          end;
+        end;
+  finally
+    Src.Free
+  end;
+end;
+
+
+
+end.

tests/utils/unittests/tcanalyst.pas

@@ -5,7 +5,7 @@ unit tcanalyst;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testregistry, testu, dbtests, tresults, sqldb, digestanalyst, pqconnection, tcsetup, tctestsql;
+  Classes, SysUtils, fpcunit, testregistry, sqldb, digestanalyst, pqconnection, tcsetup, tctestsql, tsutils, tsdb, tstypes;
 
 type
 
@@ -45,7 +45,7 @@ begin
   if not Assigned(TDBHelper.SQL) then
     TDBHelper.Setup;
   FSQL:=TDBHelper.SQL;
-  FAnalyst:=TDBDigestAnalyzer.Create(FSQL);
+  FAnalyst:=TDBDigestAnalyzer.Create(FSQL,'');
   TDBHelper.ClearAllTables;
 end;
 
@@ -148,11 +148,12 @@ begin
   AssertTrue('New record was marked as last (status)',lResults2.TestResult=lResults.TestResult);
 end;
 
+
 procedure TTestAnalyst.TestSaveResultsIdentical;
 
 var
   lData : TTestRunData;
-  lResults2,lResults : TTestResultData;
+  lResults : TTestResultData;
   lResultID : Int64;
 
 begin
@@ -167,23 +168,6 @@ begin
   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

tests/utils/unittests/tcsetup.pas

@@ -5,7 +5,7 @@ unit tcsetup;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, testdecorator, dbtests, sqldb, pqconnection;
+  Classes, SysUtils, fpcunit, testutils, testregistry, testdecorator, tsdb, sqldb, pqconnection;
 
 type
   { TDBHelper }
@@ -167,16 +167,17 @@ end;
 
 class procedure TDBHelper.ClearAllTables;
 begin
+  ClearTable('TESTRUNHISTORY');
+  ClearTable('TESTPREVIOUSRESULTS');
+  ClearTable('TESTLASTRESULTS');
+  ClearTable('TESTRESULTS');
+  ClearTable('TESTRUN');
+  ClearTable('TESTPLATFORM');
   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;

tests/utils/unittests/tctestsql.pas

@@ -5,10 +5,8 @@ unit tctestsql;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testregistry, testu, dbtests, tresults, sqldb, pqconnection;
+  Classes, SysUtils, fpcunit, testregistry, tsutils, tsdb, tstypes, sqldb, pqconnection;
 
-const
-  Bools : Array[Boolean] of string = ('f','t');
 
 type
   { TTestSQLCase }
@@ -29,6 +27,7 @@ type
   TTestSQLCase = class(TTestBaseSQLCase)
   const
     SQLTestResultFilter = '(TR_ID=%d) and (TR_TESTRUN_FK=%d) and (TR_TEST_FK=%d) and (TR_OK=''%s'') and (TR_SKIP=''%s'') and (TR_RESULT=%d) and (TR_LOG=''%s'')';
+  private
   protected
     function GetSQL: TTestSQL; override;
   protected
@@ -41,6 +40,7 @@ type
     procedure TestAddVersion;
     procedure TestAddCategory;
     procedure TestAddTest;
+    Procedure TestUpdateTest;
     procedure TestAddPlatform;
     Procedure TestAddRun;
     procedure TestUpdateRun;
@@ -58,13 +58,17 @@ type
     procedure TestGetVersionID;
     procedure TestGetTestID;
     procedure TestGetRunID;
+    procedure TestHistoryNoHistory;
+    procedure TestHistoryWithHistory;
+    Procedure TestGetPreviousTestRun;
+    Procedure TestGetNextTestRun;
   end;
 
 
 
 implementation
 
-uses tcsetup;
+uses tsstring, tcsetup;
 
 { TTestBaseSQLCase }
 
@@ -111,7 +115,9 @@ begin
     aData.VersionID:=SQL.AddVersion('w',Date);
 
   aData.config:='v';
+  aData.machine:='w';
   Result:=SQL.GetPlatformID(aData,False);
+
   if Result=-1 then
     Result:=SQL.AddPlatform(aData);
 end;
@@ -126,7 +132,6 @@ begin
     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);
@@ -152,7 +157,9 @@ begin
   aResult.Date:=Date-DateOffset;
   CreateSource('x');
   if SQL.GetTestID('x.pp')=-1 then
-    aResult.TestID:=SQL.AddTest('x.pp',False);
+    aResult.TestID:=SQL.AddTest('x.pp',False)
+  else
+    aResult.TestID:=SQL.GetTestID('x.pp');
   aResult.TestResult:=stSuccessCompilationFailed;
   aResult.Log:='xyz';
   With aData do
@@ -220,12 +227,106 @@ begin
   AssertEquals('exists',1,TDBHelper.CountRecords('TESTS',Format('(T_ID=%d) and (t_name=''x.pp'')',[lID])));
 end;
 
+procedure TTestSQLCase.TestUpdateTest;
+var
+  lInfo : TTestInfo;
+  lID : Integer;
+  lFilter : string;
+begin
+  lID:=SQL.AddTest('x.pp',False);
+  lInfo:=Default(TTestInfo);
+  With lInfo do
+    begin
+    Name:='name';  // Will not be changed
+    CPU:='cpu';
+    OS:='os';
+    Version:='version';
+    AddDate:=Date-1; // Will not be changed
+    Graph:=True;
+    Interactive:=True;
+    Result:=123;
+    Fail:=True;
+    ReCompile:=True;
+    NoRun:=True;
+    NeedLibrary:=True;
+    KnownRunError:=456;
+    Known:=True;
+    Note:='note';
+    Description:='description';
+    Source:='source';
+    Opts:='opts';
+    DelOptions:='deloptions';
+    SkipCPU:='skipcpu';
+    SkipEmu:='skipemu';
+    NeedTarget:='needtarget';
+    SkipTarget:='skiptarget';
+    MaxVersion:='maxversion';
+    KnownRunNote:='knownrunnote';
+    KnownCompileNote:='knowncompilenote';
+    RecompileOpt:='recompileopt';
+    KnownCompileError:=789;
+    NeededAfter:=True;
+    IsKnownRunError:=True;
+    Timeout:=543;
+    Category:='category';
+    Files:='files';
+    ConfigFileSrc:='configfilesrc';
+    ConfigFileDst:='configfiledst';
+    WpoParas:='wpoparas';
+    WpoPasses:=321;
+    DelFiles:='delfiles';
+    ExpectMsgs:=[1,2,3];
+    end;
+  SQL.UpdateTest(lID,lInfo,'xyz');
+  // Construct filter with the values we expect.
+  lFilter := Format('(T_ID = %d) AND ',[lID])
+  + '(T_Name = ''x.pp'') AND '
+  + '(T_CPU = ''cpu'') AND '
+  + '(T_OS = ''os'') AND '
+  + '(T_Version = ''version'') AND '
+  + '(T_AddDate = '''+TTestSQL.SQLDate(Date)+''') AND '
+  + '(T_Graph = ''t'') AND '
+  + '(T_Interactive = ''t'') AND '
+  + '(T_Result = 123) AND '
+  + '(T_Fail = ''t'') AND '
+  + '(T_ReCompile = ''t'') AND '
+  + '(T_NoRun = ''t'') AND '
+  + '(T_NeedLibrary = ''t'') AND '
+  + '(T_KnownRunError = 456) AND '
+  + '(T_Known = ''t'') AND '
+  + '(T_Note = ''note'') AND '
+  + '(T_Description = ''description'') AND '
+  + '(T_Source = ''source'') AND '
+  + '(T_Opts = ''opts'') AND '
+  + '(T_DELOPTS =''deloptions'') AND '
+  + '(T_SKIPCPU = ''skipcpu'') AND '
+  + '(T_NEEDTARGET = ''needtarget'') AND '
+  + '(T_MAXVERSION = ''maxversion'') AND '
+  + '(T_KNOWNRUNNOTE = ''knownrunnote'') AND '
+  + '(T_KNOWNCOMPILENOTE = ''knowncompilenote'') AND '
+  + '(T_RECOMPILEOPT = ''recompileopt'') AND '
+  + '(T_KNOWNCOMPILEERROR = 789) AND '
+  + '(T_NEEDEDAFTER = ''t'') AND '
+  + '(T_ISKNOWNRUNERROR = ''t'') AND '
+  + '(T_Timeout = 543) AND '
+  + '(T_CATEGORY = ''category'') AND '
+  + '(T_FILES = ''files'') AND '
+  + '(T_CONFIGFILESRC = ''configfilesrc'') AND '
+  + '(T_CONFIGFILEDST = ''configfiledst'') AND '
+  + '(T_WPOPARAS = ''wpoparas'') AND '
+  + '(T_WPOPASSES = 321) AND '
+  + '(T_DELFILES = ''delfiles'') AND '
+  + '(T_EXPECTMSGS = ''1,2,3'')' ;
+  // We should have 1 record with this filter
+  AssertEquals('Updated',1,TDBHelper.CountRecords('TESTS',lFilter));
+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'')';
+              'and (TP_VERSION_FK=%d) and (TP_CONFIG=''%s'') and (TP_MACHINE=''%s'')';
 var
   lData : TTestRunData;
   lID : integer;
@@ -234,7 +335,7 @@ begin
   lData:=Default(TTestRunData);
   lID:=PreparePlatform(lData);
   With lData do
-    flt:=Format(SQLFilter,[lID,OSID,CPUID,VersionID,Config]);
+    flt:=Format(SQLFilter,[lID,OSID,CPUID,VersionID,Config,Machine]);
   AssertEquals('Platform',1,TDBHelper.CountRecords('TESTPLATFORM',Flt));
 end;
 
@@ -521,6 +622,65 @@ begin
   DeleteSource('x');
 end;
 
+procedure TTestSQLCase.TestHistoryNoHistory;
+
+Var
+  lData : TTestRunData;
+  lResultID : Int64;
+
+begin
+  AssertEquals('count TESTRUNHISTORY before',0,TDBHelper.CountRecords('TESTRUNHISTORY'));
+  lData:=Default(TTestRunData);
+  lData.PlatformID:=PreparePlatform(lData);
+  lData.Date:=Date;
+  lResultID:=SQL.AddRun(lData);
+  AssertEquals('count TESTRUN', 1, TDBHelper.CountRecords('TESTRUN',Format('(TU_ID=%d)',[lResultID])));
+  AssertEquals('count TESTRUNHISTORY after',0,TDBHelper.CountRecords('TESTRUNHISTORY'));
+end;
+
+procedure TTestSQLCase.TestHistoryWithHistory;
+
+Var
+  lData : TTestRunData;
+  lResult1ID,lResult2ID : Int64;
+  lFilter : String;
+
+begin
+  AssertEquals('count TESTRUNHISTORY before',0,TDBHelper.CountRecords('TESTRUNHISTORY'));
+  lData:=Default(TTestRunData);
+  lData.PlatformID:=PreparePlatform(lData);
+  lData.Date:=Date-1;
+  lResult1ID:=SQL.AddRun(lData);
+  AssertEquals('count TESTRUN', 1, TDBHelper.CountRecords('TESTRUN',Format('(TU_ID=%d)',[lResult1ID])));
+  AssertEquals('count TESTRUNHISTORY after',0,TDBHelper.CountRecords('TESTRUNHISTORY'));
+  lData.Date:=Date;
+  lResult2ID:=SQL.AddRun(lData);
+  AssertEquals('count TESTRUN', 1, TDBHelper.CountRecords('TESTRUN',Format('(TU_ID=%d)',[lResult2ID])));
+  lFilter:=Format('(TH_ID_FK=%d) and (TH_PREVIOUS_FK=%d)',[lResult2ID,lResult1ID]);
+  AssertEquals('count TESTRUNHISTORY after',1,TDBHelper.CountRecords('TESTRUNHISTORY',lFilter));
+end;
+
+procedure TTestSQLCase.TestGetPreviousTestRun;
+begin
+  TDBHelper.ExecSQL('INSERT INTO TESTRUNHISTORY VALUES (2,1)');
+  TDBHelper.ExecSQL('INSERT INTO TESTRUNHISTORY VALUES (3,2)');
+  TDBHelper.ExecSQL('INSERT INTO TESTRUNHISTORY VALUES (4,3)');
+  AssertEquals('First',-1,SQL.GetPreviousRunID(1));
+  AssertEquals('Second',1,SQL.GetPreviousRunID(2));
+  AssertEquals('third',2,SQL.GetPreviousRunID(3));
+  AssertEquals('last',3,SQL.GetPreviousRunID(4));
+end;
+
+procedure TTestSQLCase.TestGetNextTestRun;
+begin
+  TDBHelper.ExecSQL('INSERT INTO TESTRUNHISTORY VALUES (2,1)');
+  TDBHelper.ExecSQL('INSERT INTO TESTRUNHISTORY VALUES (3,2)');
+  TDBHelper.ExecSQL('INSERT INTO TESTRUNHISTORY VALUES (4,3)');
+  AssertEquals('First',2,SQL.GetNextRunID(1));
+  AssertEquals('Second',3,SQL.GetNextRunID(2));
+  AssertEquals('third',4,SQL.GetNextRunID(3));
+  AssertEquals('last',-1,SQL.GetNextRunID(4));
+end;
 
 
 initialization

tests/utils/unittests/tctsutils.pas

@@ -0,0 +1,301 @@
+unit tctsutils;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, tsutils, tstypes;
+
+Type
+
+  { TTestUtilsCase }
+
+  TTestUtilsCase = class(TTestCase)
+  Private
+    FConfig : TConfig;
+    FFileName : String;
+    FReadResult : Boolean;
+  Public
+    procedure SetUp; override;
+    procedure TearDown; override;
+    procedure DoRead;
+    procedure CreateFile(const aLines : Array of string);
+    Property ReadResult : Boolean Read FReadResult;
+  Published
+    procedure TestNoFile;
+    procedure TestEmptyFile;
+    procedure TestNoPercent;
+    procedure TestNoEndComment;
+    procedure TestSpaces;
+    procedure TestCodeAndNote;
+    procedure TestConfig;
+    procedure TestNeedOptions;
+    procedure TestDelOptions;
+    Procedure TestNeedTarget;
+    Procedure TestSkipTarget;
+    procedure TestNeedCPU;
+    procedure TestSkipCPU;
+    Procedure TestSkipEMU;
+    Procedure TestMinVersion;
+    Procedure TestMaxVersion;
+    Procedure TestResultCode;
+    Procedure TestUsesGraph;
+    Procedure TestShouldFail;
+    procedure TestNoRun;
+    Procedure TestNeedLibrary;
+    Procedure TestNeedAfter;
+    procedure TestTimeout;
+    procedure TestFiles;
+    Procedure TestWPOParas;
+    Procedure TestWPOPasses;
+    Procedure TestDelFiles;
+    Procedure TestInteractive;
+  end;
+
+implementation
+
+{ TTestUtilsCase }
+
+procedure TTestUtilsCase.SetUp;
+begin
+  inherited SetUp;
+  FReadResult:=False;
+  FFileName:=GetTempDir(False)+TestName+'.pas';
+  if FileExists(FFileName) then
+    if not DeleteFile(FFileName) then
+      Fail('Failed to delete file '+FFileName);
+end;
+
+procedure TTestUtilsCase.TearDown;
+begin
+  if (FFileName<>'') and FileExists(FFileName) then
+    if not DeleteFile(FFileName) then
+      Fail('Failed to delete file '+FFileName);
+  inherited TearDown;
+end;
+
+procedure TTestUtilsCase.DoRead;
+begin
+  FReadResult:=GetConfig('tc',FFileName,FConfig);
+end;
+
+procedure TTestUtilsCase.CreateFile(const aLines: array of string);
+var
+  l : TStrings;
+begin
+  L:=TStringList.Create;
+  try
+    l.AddStrings(aLines,True);
+    l.SaveToFile(FFileName);
+  finally
+    l.Free;
+  end;
+end;
+
+procedure TTestUtilsCase.TestNoFile;
+begin
+  DoRead;
+  AssertFalse('Not read',ReadResult);
+end;
+
+procedure TTestUtilsCase.TestEmptyFile;
+begin
+  CreateFile([]);
+  DoRead;
+  AssertTrue('read',ReadResult);
+end;
+
+procedure TTestUtilsCase.TestNoPercent;
+begin
+  CreateFile(['{CPU=X}']);
+  DoRead;
+  AssertTrue('read',ReadResult);
+  AssertEquals('No value','',FCOnfig.NeedCPU);
+end;
+
+procedure TTestUtilsCase.TestNoEndComment;
+begin
+  CreateFile(['{ %CPU=X']);
+  DoRead;
+  AssertTrue('read',ReadResult);
+  AssertEquals('No value','',FConfig.NeedCPU);
+end;
+
+procedure TTestUtilsCase.TestSpaces;
+begin
+  CreateFile(['{ %CPU = X }']);
+  DoRead;
+  AssertTrue('read',ReadResult);
+  AssertEquals('No value','X',FConfig.NeedCPU);
+end;
+
+procedure TTestUtilsCase.TestCodeAndNote;
+begin
+  CreateFile(['{%KNOWNRUNERROR=123X }']);
+  DoRead;
+  AssertTrue('read',ReadResult);
+  AssertEquals('Runerror value',123,FConfig.KnownRunError);
+  AssertEquals('RunError note','X',FConfig.KnownRunNote);
+end;
+
+procedure TTestUtilsCase.TestConfig;
+begin
+  CreateFile(['{%CONFIGFILE=X.CFG Y.CFG}']);
+  DoRead;
+  AssertTrue('read',ReadResult);
+  AssertEquals('Runerror value','X.CFG',FConfig.ConfigFileSrc);
+  AssertEquals('RunError note','Y.CFG',FConfig.ConfigFileDst);
+end;
+
+procedure TTestUtilsCase.TestNeedOptions;
+begin
+  CreateFile(['{%OPT=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.NeedOptions);;
+end;
+
+procedure TTestUtilsCase.TestDelOptions;
+begin
+  CreateFile(['{%DELOPT=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.DelOptions);;
+end;
+
+procedure TTestUtilsCase.TestNeedTarget;
+begin
+  CreateFile(['{%TARGET=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.NeedTarget);;
+end;
+
+procedure TTestUtilsCase.TestSkipTarget;
+begin
+  CreateFile(['{%SKIPTARGET=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.SkipTarget);;
+end;
+
+procedure TTestUtilsCase.TestNeedCPU;
+begin
+  CreateFile(['{%SKIPEMU=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.SkipEmu);;
+end;
+
+procedure TTestUtilsCase.TestSkipCPU;
+begin
+  CreateFile(['{%SKIPEMU=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.SkipEmu);;
+end;
+
+procedure TTestUtilsCase.TestSkipEMU;
+begin
+  CreateFile(['{%SKIPEMU=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.SkipEmu);;
+end;
+
+procedure TTestUtilsCase.TestMinVersion;
+begin
+  CreateFile(['{%VERSION=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.MinVersion);;
+end;
+
+procedure TTestUtilsCase.TestMaxVersion;
+begin
+  CreateFile(['{%MAXVERSION=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.MaxVersion);;
+end;
+
+procedure TTestUtilsCase.TestResultCode;
+begin
+  CreateFile(['{%RESULT=1}']);
+  DoRead;
+  AssertEquals('Value',1,FConfig.ResultCode);
+end;
+
+procedure TTestUtilsCase.TestUsesGraph;
+begin
+  CreateFile(['{%GRAPH}']);
+  DoRead;
+  AssertTrue('Value',FConfig.UsesGraph);
+end;
+
+procedure TTestUtilsCase.TestShouldFail;
+begin
+  CreateFile(['{%FAIL}']);
+  DoRead;
+  AssertTrue('Value',FConfig.ShouldFail);
+end;
+
+procedure TTestUtilsCase.TestNoRun;
+begin
+  CreateFile(['{%NORUN}']);
+  DoRead;
+  AssertTrue('Value',FConfig.NoRun);
+end;
+
+procedure TTestUtilsCase.TestNeedLibrary;
+begin
+  CreateFile(['{%NEEDLIBRARY}']);
+  DoRead;
+  AssertTrue('Value',FConfig.NeedLibrary);
+end;
+
+procedure TTestUtilsCase.TestNeedAfter;
+begin
+  CreateFile(['{%NEEDEDAFTER}']);
+  DoRead;
+  AssertTrue('Value',FConfig.NeededAfter);
+end;
+
+procedure TTestUtilsCase.TestTimeout;
+begin
+  CreateFile(['{%TIMEOUT=123}']);
+  DoRead;
+  AssertEquals('Value',123,FConfig.Timeout)
+end;
+
+procedure TTestUtilsCase.TestFiles;
+begin
+  CreateFile(['{%FILES=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.Files);;
+end;
+
+procedure TTestUtilsCase.TestWPOParas;
+begin
+  CreateFile(['{%WPOPARAS=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.wpoparas);;
+end;
+
+procedure TTestUtilsCase.TestWPOPasses;
+begin
+  CreateFile(['{%WPOPASSES=2}']);
+  DoRead;
+  AssertEquals('Value',2,FConfig.wpopasses);
+end;
+
+procedure TTestUtilsCase.TestDelFiles;
+begin
+  CreateFile(['{%DELFILES=XYZ}']);
+  DoRead;
+  AssertEquals('Value','XYZ',FConfig.DelFiles);
+end;
+
+procedure TTestUtilsCase.TestInteractive;
+begin
+  CreateFile(['{%INTERACTIVE}']);
+  DoRead;
+  AssertTrue('Value',FConfig.IsInteractive);
+end;
+
+initialization
+  RegisterTest(TTestUtilsCase);
+end.
+

tests/utils/unittests/testdbdigest.lpi

@@ -3,11 +3,24 @@
   <ProjectOptions>
     <Version Value="12"/>
     <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <SaveJumpHistory Value="False"/>
+        <SaveFoldState Value="False"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
       <Title Value="testdbdigest"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
+    <CustomData Count="3">
+      <Item0 Name="OpenAPIBase"/>
+      <Item1 Name="OpenAPIConfig"/>
+      <Item2 Name="OpenAPIFile"/>
+    </CustomData>
     <BuildModes>
       <Item Name="Default" Default="True"/>
     </BuildModes>
@@ -32,10 +45,6 @@
         <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"/>
@@ -48,6 +57,26 @@
         <Filename Value="tcanalyst.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="../tstypes.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../tsdb.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../tsstring.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../tsutils.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="tctsutils.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

tests/utils/unittests/testdbdigest.lpr

@@ -3,7 +3,7 @@ program testdbdigest;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, tctestsql, dbtests, digestanalyst, tcsetup, tcanalyst;
+  Classes, consoletestrunner, tctestsql, digestanalyst, tsdb, tstypes, tsstring, tsutils, tcsetup, tcanalyst, tctsutils;
 
 type
 
@@ -18,6 +18,8 @@ var
   Application: TMyTestRunner;
 
 begin
+  // Will stop V_ERROR from exiting.
+  IsCGI:=True;
   DefaultRunAllTests:=True;
   DefaultFormat:=fPlain;
   Application := TMyTestRunner.Create(nil);