+ Added dbdigest to store results in a database

tests/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2002/12/17]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2002/10/05]
 #
 default: allexectests
 MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx
@@ -58,7 +58,7 @@ ifdef inUnix
 PATHSEP=/
 else
 PATHSEP:=$(subst /,\,/)
-ifdef inCygWin
+ifneq ($(findstring sh.exe,$(SHELL)),)
 PATHSEP=/
 endif
 endif
@@ -406,6 +406,20 @@ endif
 else
 CROSSBINDIR=
 endif
+ifdef inUnix
+ifndef GCCLIBDIR
+GCCLIBDIR:=$(shell dirname `(gcc -v 2>&1)| head -n 1| awk '{ print $$4 } '`)
+endif
+ifeq ($(OS_TARGET),linux)
+ifndef OTHERLIBDIR
+OTHERLIBDIR:=$(shell grep -v "^\#" /etc/ld.so.conf | awk '{ ORS=" "; print $1 }')
+endif
+endif
+ifeq ($(OS_TARGET),netbsd)
+OTHERLIBDIR+=/usr/pkg/lib
+endif
+export GCCLIBDIR OTHERLIB
+endif
 LOADEREXT=.as
 EXEEXT=.exe
 PPLEXT=.ppl
@@ -763,6 +777,38 @@ else
 TAROPT=vz
 TAREXT=.tar.gz
 endif
+ifeq ($(OS_TARGET),linux)
+REQUIRE_PACKAGES_MYSQL=1
+endif
+ifeq ($(OS_TARGET),win32)
+REQUIRE_PACKAGES_MYSQL=1
+endif
+ifdef REQUIRE_PACKAGES_MYSQL
+PACKAGEDIR_MYSQL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /mysql/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_MYSQL),)
+ifneq ($(wildcard $(PACKAGEDIR_MYSQL)/$(OS_TARGET)),)
+UNITDIR_MYSQL=$(PACKAGEDIR_MYSQL)/$(OS_TARGET)
+else
+UNITDIR_MYSQL=$(PACKAGEDIR_MYSQL)
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_MYSQL)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_MYSQL) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_MYSQL)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_MYSQL=
+UNITDIR_MYSQL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /mysql/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_MYSQL),)
+UNITDIR_MYSQL:=$(firstword $(UNITDIR_MYSQL))
+else
+UNITDIR_MYSQL=
+endif
+endif
+ifdef UNITDIR_MYSQL
+override COMPILER_UNITDIR+=$(UNITDIR_MYSQL)
+endif
+endif
 ifndef NOCPUDEF
 override FPCOPTDEF=$(CPU_TARGET)
 endif
@@ -853,6 +899,12 @@ override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
 override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
 endif
 endif
+ifdef GCCLIBDIR
+override FPCOPT+=-Fl$(GCCLIBDIR)
+endif
+ifdef OTHERLIBDIR
+override FPCOPT+=$(addprefix -Fl,$(OTHERLIBDIR))
+endif
 ifdef OPT
 override FPCOPT+=$(OPT)
 endif
@@ -1086,9 +1138,17 @@ endif
 ifneq ($(TESTCOMSPECRES),)
 NOCOMSPEC=1
 endif
+ifeq ($(USESQL),YES)
+DIGEST=./dbdigest$(EXEEXT)
+DBDIGEST=utils/dbtests.pp
+DIGESTSRC=utils/dbdigest.pp
+else
 DIGEST=./digest$(EXEEXT)
-$(DIGEST) : units utils/digest.pp utils/teststr.pp
-	$(FPC) -n -Fuunits -FE. utils/digest.pp
+DBDIGEST=
+DIGESTSRC=utils/digest.pp
+endif
+$(DIGEST) : units utils/digest.pp utils/teststr.pp utils/testu.pp $(DBDIGEST)
+	$(FPC) -n -Fuunits -FE. $(DIGESTSRC)
 testcheck: units allpreps $(DOTEST)
 ifneq ($(FPC),ppc386$(EXEEXT))
 ifeq ($(findstring -c$(FPC),$(DOTESTOPT)),)

tests/Makefile.fpc

@@ -9,6 +9,9 @@ fpcpackage=y
 fpcdir=..
 rule=allexectests
 
+[require]
+packages_win32=mysql
+packages_linux=mysql
 
 [rules]
 # Subdirs available in the test subdir
@@ -72,9 +75,17 @@ ifneq ($(TESTCOMSPECRES),)
 NOCOMSPEC=1
 endif
 
+ifeq ($(USESQL),YES)
+DIGEST=./dbdigest$(EXEEXT)
+DBDIGEST=utils/dbtests.pp
+DIGESTSRC=utils/dbdigest.pp
+else
 DIGEST=./digest$(EXEEXT)
-$(DIGEST) : units utils/digest.pp utils/teststr.pp
-        $(FPC) -n -Fuunits -FE. utils/digest.pp
+DBDIGEST=
+DIGESTSRC=utils/digest.pp
+endif
+$(DIGEST) : units utils/digest.pp utils/teststr.pp utils/testu.pp $(DBDIGEST)
+        $(FPC) -n -Fuunits -FE. $(DIGESTSRC)
 
 testcheck: units allpreps $(DOTEST)
 

tests/utils/dbdigest.pp

@@ -0,0 +1,415 @@
+{
+  $Id$
+    This file is part of the Free Pascal test suite.
+    Copyright (c) 2002 by the Free Pascal development team.
+
+    This program generates a digest
+    of 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+}
+
+program digest;
+
+uses
+  sysutils,teststr,testu,dbtests;
+
+
+Type
+  TTestStatus = (
+  stFailedToCompile,
+  stSuccessCompilationFailed,
+  stFailedCompilationsuccessful,
+  stSuccessfullyCompiled,
+  stFailedToRun,
+  stKnownRunProblem,
+  stSuccessFullyRun,
+  stSkippingGraphTest,
+  stSkippingInteractiveTest,
+  stSkippingKnownBug,
+  stSkippingCompilerVersionTooLow,
+  stSkippingOtherCpu,
+  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, // stSkippingOtherCpu,
+    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,   // stSkippingOtherCpu,
+    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,  // stSkippingOtherCpu,
+    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_other_cpu ,
+    skipping_run_unit ,
+    skipping_run_test
+  );
+
+Var
+  StatusCount : Array[TTestStatus] of Integer;
+  UnknownLines,
+  unexpected_run : Integer;
+  next_should_be_run : boolean;
+ 
+var
+  prevline : string;
+  
+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;
+  Found : Boolean;
+  
+begin
+  TS:=FirstStatus;
+  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);
+      Writeln('Detected status ',Ord(ts),' ',StatusText[TS]);
+      Break;
+      end;
+    TS:=succ(TS);
+    end;
+end;
+
+Type
+
+TConfigOpt = (
+  coDatabaseName,
+  soHost,
+  coUserName,
+  coPassword,
+  coLogFile,
+  coOS,
+  coCPU,
+  coDate
+ );
+
+Const
+
+ConfigStrings : Array [TConfigOpt] of string = (
+  'databasename',
+  'host',
+  'username',
+  'password',
+  'logfile',
+  'os',
+  'cpu',
+  'date'
+);
+
+ConfigOpts : Array[TConfigOpt] of char 
+           = ('d','h','u','p','l','o','c','t');
+
+Var
+  TestOS,
+  TestCPU,
+  DatabaseName,
+  HostName,
+  UserName,
+  Password,
+  LogFileName  : String;
+  TestDate : TDateTime;
+  
+Procedure SetOpt (O : TConfigOpt; Value : string);
+
+begin
+  Case O of
+    coDatabaseName : DatabaseName:=Value;
+    soHost         : HostName:=Value;
+    coUserName     : UserName:=Value;
+    coPassword     : Password:=Value;
+    coLogFile      : LogFileName:=Value;
+    coOS           : TestOS:=Value;
+    coCPU          : TestCPU:=Value; 
+    coDate         : TestDate:=StrToDate(Value);
+  end;
+end;
+
+Function ProcessOption(S: String) : Boolean;
+
+Var
+  N : String;
+  I : Integer;
+  Found : Boolean;
+  co,o : TConfigOpt;  
+    
+begin
+  Writeln('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:=coDatabaseName to coDate do
+      begin
+      Result:=CompareText(ConfigStrings[co],N)=0;
+      If Result then
+        begin
+        o:=co;
+        Break;
+        end;
+      end;
+    end;  
+ If Result then   
+   SetOpt(co,S)
+ else  
+   Verbose(V_ERROR,'Unknown option : '+S);
+end;
+
+Procedure ProcessConfigfile(FN : String);
+
+Var
+  F : Text;
+  S : String;
+  I : Integer;
+  
+begin
+  If Not FileExists(FN) Then
+    Exit;
+  Writeln('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,V : String;
+  c,co : TConfigOpt;
+  Found : Boolean;
+  
+begin
+  I:=1;
+  While I<=ParamCount do
+    begin
+    O:=Paramstr(I);
+    Found:=Length(O)=2;
+    If Found then
+      For co:=coDatabaseName to coDate do
+        begin
+        Found:=(O[2]=ConfigOpts[co]);
+        If Found then
+          begin
+          c:=co;
+          Break;
+          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;      
+
+Var
+  TestCPUID : Integer;
+  TestOSID  : Integer;
+
+Procedure GetIDs;
+
+begin
+  TestCPUID := GetCPUId(TestCPU);
+  If TestCPUID=-1 then
+    Verbose(V_Error,'NO ID for CPU "'+TestCPU+'" found.');
+  TestOSID  := GetOSID(TestOS);
+  If TestOSID=-1 then
+    Verbose(V_Error,'NO ID for OS "'+TestOS+'" found.');
+  If (Round(TestDate)=0) then 
+    Testdate:=Date;
+end;
+
+Function GetLog(FN : String) : String;
+
+begin
+  FN:=ChangeFileExt(FN,'.elg');
+  If FileExists(FN) then
+    Result:=GetFileContents(FN)
+  else
+    Result:='';  
+end;
+
+Procedure Processfile (FN: String);
+
+var
+  logfile : text;
+  line : string;
+  TS : TTestStatus;
+  ID : integer;
+  Testlog : string;
+  
+begin
+  Assign(logfile,FN);
+{$i-}
+  reset(logfile);
+  if ioresult<>0 then
+    Verbose(V_Error,'Unable to open log file'+logfilename);
+{$i+}
+  while not eof(logfile) do
+    begin
+    readln(logfile,line);
+    If analyse(line,TS) then
+      begin
+      Inc(StatusCount[TS]);
+      If Not ExpectRun[TS] then
+        begin
+        ID:=RequireTestID(Line);
+        If (ID<>-1) then
+          begin
+          If Not (TestOK[TS] or TestSkipped[TS]) then
+            TestLog:=GetLog(Line)
+          else
+            TestLog:='';  
+          AddTestResult(ID,TestOSID,TestCPUID,Ord(TS),
+                        TestOK[TS],TestSkipped[TS],
+                        TestLog,
+                        TestDate);
+          end;              
+        end
+      end  
+    else
+      Inc(UnknownLines);  
+    end;
+  close(logfile);
+end;
+
+
+begin
+  ProcessConfigFile('dbdigest.cfg');
+  ProcessCommandLine;
+  If LogFileName<>'' then
+    begin
+    ConnectToDatabase(DatabaseName,HostName,UserName,Password);
+    GetIDs;
+    ProcessFile(LogFileName)
+    end
+  else  
+    Verbose(V_ERROR,'Missing log file name');
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-12-17 15:04:32  michael
+  + Added dbdigest to store results in a database
+
+  Revision 1.2  2002/11/18 16:42:43  pierre
+   + KNOWNRUNERROR added
+
+  Revision 1.1  2002/11/13 15:26:24  pierre
+   + digest program added
+
+}

tests/utils/dbtests.pp

@@ -0,0 +1,292 @@
+{$mode objfpc}
+{$H+}
+
+unit dbtests;
+
+Interface 
+
+Uses 
+  mysql,testu;
+
+{ ---------------------------------------------------------------------
+  High-level access  
+  ---------------------------------------------------------------------}
+
+Function GetTestID(Name : string) : Integer; 
+Function GetOSID(Name : String) : Integer;
+Function GetCPUID(Name : String) : Integer;
+Function AddTest(Name : String; AddSource : Boolean) : Integer;
+Function UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
+Function AddTestResult(TestID,OSID,CPUID,TestRes : Integer; 
+                       OK, Skipped : Boolean;
+                       Log : String;
+                       TestDate : TDateTime) : Integer;
+Function RequireTestID(Name : String): Integer;
+
+{ ---------------------------------------------------------------------
+    Low-level DB access.
+  ---------------------------------------------------------------------}
+ 
+
+Type
+  TQueryResult = PMYSQL_RES;
+
+Function  ConnectToDatabase(DatabaseName,Host,User,Password : String) : Boolean;
+Procedure DisconnectDatabase;
+Function  RunQuery (Qry : String; Var res : TQueryResult) : Boolean ;
+Procedure FreeQueryResult (Res : TQueryResult);
+Function  GetResultField (Res : TQueryResult; Id : Integer) : String;
+Function  IDQuery(Qry : String) : Integer;
+Function  EscapeSQL( S : String) : String;
+
+Implementation
+
+Uses 
+  SysUtils;
+
+{ ---------------------------------------------------------------------
+    Low-level DB access.
+  ---------------------------------------------------------------------}
+
+
+Var
+  Connection : TMYSQL;
+    
+
+Function ConnectToDatabase(DatabaseName,Host,User,Password : String) : Boolean;
+
+Var 
+  S : String;
+
+begin
+  Verbose(V_DEBUG,'Connection params : '+DatabaseName+' '+Host+' '+User+' '+Password);
+  Result:=mysql_connect(@Connection,PChar(Host),PChar(User),PChar(Password))<>Nil;
+  If Not Result then 
+    begin
+    S:=Strpas(mysql_error(@connection));
+    Verbose(V_ERROR,'Failed to connect to database : '+S);
+    end
+  else
+    begin
+    Result:=Mysql_select_db(@Connection,Pchar(DatabaseName))>=0;
+    If Not result then
+      begin
+      S:=StrPas(mysql_error(@connection));
+      DisconnectDatabase;
+      Verbose(V_Error,'Failed to select database : '+S);
+      end;
+    end;  
+end;
+
+Procedure DisconnectDatabase;
+
+begin
+  mysql_close(@Connection);
+end;
+
+Function RunQuery (Qry : String; Var res : TQueryResult) : Boolean ;
+
+begin
+  Verbose(V_DEBUG,'Running query:'+Qry);
+  Result:=mysql_query(@Connection,PChar(qry))>=0;
+  If Not Result then
+    Verbose(V_WARNING,'Query : '+Qry+'Failed : '+Strpas(mysql_error(@connection)))
+  else
+    Res:=Mysql_store_result(@connection);
+end;
+
+Function GetResultField (Res : TQueryResult; Id : Integer) : String;
+
+Var
+  Row : TMYSQL_ROW;
+
+begin
+  if Res=Nil then
+    Result:=''
+  else  
+    begin
+    Row:=mysql_fetch_row(Res);
+    If (Row=Nil) or (Row[ID]=Nil) then
+      Result:=''
+    else  
+      Result:=strpas(Row[ID]); 
+    end;
+  Verbose(V_DEBUG,'Field value '+Result);  
+end;
+
+Procedure FreeQueryResult (Res : TQueryResult);
+
+begin
+  mysql_free_result(Res);
+end;
+
+Function IDQuery(Qry : String) : Integer;
+
+Var
+  Res : TQueryResult;
+
+begin
+  Result:=-1;
+  If RunQuery(Qry,Res) then
+    begin
+    Result:=StrToIntDef(GetResultField(Res,0),-1);
+    FreeQueryResult(Res);
+    end;
+end; 
+
+Function EscapeSQL( S : String) : String;
+
+
+begin
+  Result:=StringReplace(S,'"','\"',[rfReplaceAll]);
+  Verbose(V_DEBUG,'EscapeSQL : "'+S+'" -> "'+Result+'"');
+end;
+
+
+
+{ ---------------------------------------------------------------------
+  High-level access  
+  ---------------------------------------------------------------------}
+ 
+ 
+  
+Function GetTestID(Name : string) : Integer; 
+
+Const
+  SFromName = 'SELECT T_ID FROM TESTS WHERE (T_NAME="%s")';
+  SFromFullName = 'SELECT T_ID FROM TESTS WHERE (T_FULLNAME="%s")';
+  
+Var
+  FN : String;
+
+begin
+  FN:=ExtractFileName(Name);
+  Result:=IDQuery(Format(SFromName,[FN]));
+  If Result=-1 then
+    Result:=IDQuery(Format(SFromFullName,[Name]))
+end;
+
+Function GetOSID(Name : String) : Integer;
+
+Const 
+  SFromName = 'SELECT TO_ID FROM TESTOS WHERE (TO_NAME="%s")';
+
+begin
+  Result:=IDQuery(Format(SFromName,[Name]));
+end;
+
+Function GetCPUID(Name : String) : Integer;
+
+Const 
+  SFromName = 'SELECT TC_ID FROM TESTCPU WHERE (TC_NAME="%s")';
+
+begin
+  Result:=IDQuery(Format(SFromName,[Name]));
+end;
+
+Function AddTest(Name : String; AddSource : Boolean) : Integer;
+
+Const 
+  SInsertTest = 'INSERT INTO TESTS (T_NAME,T_FULLNAME,T_ADDDATE)'+
+                ' VALUES ("%s","%s",NOW())'; 
+
+Var
+  Info : TConfig;
+  Res  : TQueryResult;
+    
+begin
+  Result:=-1;
+  If FileExists(Name) and GetConfig(Name,Info) then
+    begin
+    If RunQuery(Format(SInsertTest,[ExtractFileName(Name),Name]),Res) then
+      begin
+      Result:=GetTestID(Name);
+      If Result=-1 then
+        Verbose(V_WARNING,'Kon toegevoegde test niet terugvinden!')
+      else
+        If AddSource then
+          UpdateTest(Result,Info,GetFileContents(Name))
+        else
+          UpdateTest(Result,Info,'');  
+      end
+    end
+  else    
+    Verbose(V_ERROR,'Kon test "'+Name+'" niet vinden of geen info extraheren.');
+end;
+
+Const
+  B : Array[Boolean] of String = ('-','+');
+
+Function UpdateTest(ID : Integer; Info : TConfig; 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';
+
+ 
+Var
+  Qry : String;
+  Res : TQueryResult;
+      
+begin
+  If Source<>'' then
+    begin
+    Source:=EscapeSQL(Source);
+    Source:=', T_SOURCE="'+Source+'"';
+    end;
+  With Info do
+    Qry:=Format(SUpdateTest,[EscapeSQL(NeedCPU),'',EscapeSQL(NeedVersion),
+                             B[usesGraph],B[IsInteractive],ResultCode,
+                             B[ShouldFail],B[NeedRecompile],B[NoRun],
+                             B[NeedLibrary],KnownRunError,
+                             B[IsKnown],EscapeSQL(Note),EscapeSQL(NeedOptions),
+                             Source,
+                             ID
+     ]);
+  Result:=RunQuery(Qry,res)
+end;
+
+Function AddTestResult(TestID,OSID,CPUID,TestRes : Integer; 
+                       OK, Skipped : Boolean;
+                       Log : String;
+                       TestDate : TDateTime) : Integer;
+
+Const
+  SInsertRes = 'Insert into TESTRESULTS ('+
+              ' TR_TEST_FK, TR_DATE, TR_CPU_FK, TR_OS_FK,'+
+              ' TR_OK, TR_SKIP, TR_RESULT, TR_LOG)'+
+              'VALUES ('+
+              ' %d,"%s",%d,%d,'+
+              ' "%s","%s",%d,"%s")';
+
+Var
+  Qry : String;
+  Res : TQueryResult;
+   
+begin
+  Result:=-1;
+  Qry:=Format(SInsertRes,[TestID,FormatDateTime('yyyymmdd',TestDate),CPUID,OSID,
+                         B[OK],B[Skipped],TestRes,EscapeSQL(Log)
+                         ]);
+  If RunQuery(Qry,Res) then
+    Result:=mysql_insert_id(@connection);
+end;
+
+Function RequireTestID(Name : String): Integer;
+
+begin
+  Result:=GetTestID(Name);
+  If Result=-1 then
+    Result:=AddTest(Name,FileExists(Name));
+  If Result=-1 then
+    Verbose(V_WARNING,'Could not find or create entry for test '+Name);
+end;
+
+end.

tests/utils/dotest.pp

@@ -14,11 +14,12 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-
+{$H+}
 program dotest;
 uses
   dos,
   teststr,
+  testu,
   redir;
 
 const
@@ -28,25 +29,6 @@ const
   ExeExt='exe';
 {$endif UNIX}
 
-type
-  TVerboseLevel=(V_Abort,V_Error,V_Warning,V_Normal,V_Debug);
-
-  TConfig = record
-    NeedOptions,
-    NeedCPU,
-    NeedVersion,
-    KnownRunNote  : string;
-    ResultCode    : longint;
-    KnownRunError : longint;
-    NeedRecompile : boolean;
-    NeedLibrary   : boolean;
-    IsInteractive : boolean;
-    IsKnown       : boolean;
-    NoRun         : boolean;
-    UsesGraph     : boolean;
-    ShouldFail    : boolean;
-    Category      : string;
-  end;
 
 var
   Config : TConfig;
@@ -61,7 +43,6 @@ var
 const
   LongLogfile : string[32] = 'longlog';
   FailLogfile : string[32] = 'faillist';
-  DoVerbose : boolean = false;
   DoGraph : boolean = false;
   DoInteractive : boolean = false;
   DoExecute : boolean = false;
@@ -69,30 +50,6 @@ const
   DoAll : boolean = false;
   DoUsual : boolean = true;
 
-procedure Verbose(lvl:TVerboseLevel;const s:string);
-begin
-  case lvl of
-    V_Normal :
-      writeln(s);
-    V_Debug :
-      if DoVerbose then
-       writeln('Debug: ',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;
-end;
-
-
 Function FileExists (Const F : String) : Boolean;
 {
   Returns True if the file exists, False if not.
@@ -144,31 +101,6 @@ 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  : longint;
-begin
-  for i:=1 to length(s) do
-   if s[i] in ['a'..'z'] then
-    upper[i]:=char(byte(s[i])-32)
-   else
-    upper[i]:=s[i];
-  upper[0]:=s[0];
-end;
 
 
 function SplitPath(const s:string):string;
@@ -283,7 +215,7 @@ var
   begin
     Getentry:=false;
     Res:='';
-    if Upper(Copy(s,1,length(entry)))=Upper(entry) then
+    if Upcase(Copy(s,1,length(entry)))=Upcase(entry) then
      begin
        Delete(s,1,length(entry));
        TrimB(s);
@@ -814,7 +746,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2002-12-15 13:30:46  peter
+  Revision 1.23  2002-12-17 15:04:32  michael
+  + Added dbdigest to store results in a database
+
+  Revision 1.22  2002/12/15 13:30:46  peter
     * NEEDLIBRARY option to add -rpath to the linker for unix. This is
       needed to test runtime library tests. The library needs the -FE.
       option to place the .so in the correct directory

tests/utils/tests.sql

@@ -0,0 +1,72 @@
+CREATE TABLE TESTS (
+  T_ID   INTEGER NOT NULL AUTO_INCREMENT,
+  T_NAME VARCHAR(80) NOT NULL,
+  T_FULLNAME VARCHAR(255) NOT NULL,
+  T_CPU VARCHAR(20),
+  T_OS VARCHAR(30),
+  T_VERSION VARCHAR(10),
+  T_ADDDATE DATE NOT NULL,
+  T_GRAPH CHAR(1) NOT NULL DEFAULT '-',
+  T_INTERACTIVE CHAR(1) NOT NULL DEFAULT '-',
+  T_RESULT INTEGER NOT NULL DEFAULT 0,
+  T_FAIL CHAR(1) NOT NULL DEFAULT '-',
+  T_RECOMPILE CHAR(1) NOT NULL DEFAULT '-',
+  T_NORUN CHAR(1) NOT NULL DEFAULT '-',
+  T_NEEDLIBRARY CHAR(1) NOT NULL DEFAULT '-',
+  T_KNOWNRUNERROR INTEGER NOT NULL DEFAULT 0,
+  T_KNOWN CHAR(1) NOT NULL DEFAULT '-',
+  T_NOTE VARCHAR(255),
+  T_DESCRIPTION TEXT,
+  T_SOURCE TEXT,
+  T_OPTS VARCHAR(255),
+  UNIQUE TESTNAME (T_NAME),
+  PRIMARY KEY PK_TEST (T_ID)
+);
+
+CREATE TABLE TESTRESULTS (
+  TR_ID INTEGER NOT NULL AUTO_INCREMENT,
+  TR_TEST_FK INTEGER NOT NULL,
+  TR_DATE TIMESTAMP NOT NULL,
+  TR_CPU_FK INTEGER,
+  TR_OS_FK INTEGER,
+  TR_OK CHAR(1) NOT NULL DEFAULT '-',
+  TR_SKIP CHAR(1) NOT NULL DEFAULT '-',
+  TR_RESULT INT NOT NULL DEFAULT 0,
+  TR_LOG TEXT,
+  PRIMARY KEY (TR_ID),
+  INDEX TR_IDATE (TR_DATE)
+);
+
+CREATE TABLE TESTOS (
+  TO_ID INTEGER NOT NULL AUTO_INCREMENT,
+  TO_NAME VARCHAR(10),
+  PRIMARY KEY (TO_ID),
+  UNIQUE TR_INAME (TO_NAME)
+);
+
+CREATE TABLE TESTCPU (
+  TC_ID INTEGER NOT NULL AUTO_INCREMENT,
+  TC_NAME VARCHAR(10),
+  PRIMARY KEY (TC_ID),
+  UNIQUE TC_INAME (TC_NAME)
+);
+
+INSERT INTO TESTOS (TO_NAME) VALUES ('linux');
+INSERT INTO TESTOS (TO_NAME) VALUES ('win32');
+INSERT INTO TESTOS (TO_NAME) VALUES ('go32v2');
+INSERT INTO TESTOS (TO_NAME) VALUES ('os2');
+INSERT INTO TESTOS (TO_NAME) VALUES ('freebsd');
+INSERT INTO TESTOS (TO_NAME) VALUES ('netbsd');
+INSERT INTO TESTOS (TO_NAME) VALUES ('openbsd');
+INSERT INTO TESTOS (TO_NAME) VALUES ('amiga');
+INSERT INTO TESTOS (TO_NAME) VALUES ('atari');
+INSERT INTO TESTOS (TO_NAME) VALUES ('qnx');
+INSERT INTO TESTOS (TO_NAME) VALUES ('beos');
+INSERT INTO TESTOS (TO_NAME) VALUES ('sunos');
+
+INSERT INTO TESTCPU (TC_NAME) VALUES ('i386');
+INSERT INTO TESTCPU (TC_NAME) VALUES ('ppc');
+INSERT INTO TESTCPU (TC_NAME) VALUES ('m68k');
+INSERT INTO TESTCPU (TC_NAME) VALUES ('sparc');
+
+ 

tests/utils/testu.pp

@@ -0,0 +1,249 @@
+{$mode objfpc}
+{$h+}
+
+unit testu;
+
+Interface
+
+{ ---------------------------------------------------------------------
+    utility functions, shared by several programs of the test suite
+  ---------------------------------------------------------------------}
+
+type
+  TVerboseLevel=(V_Abort,V_Error,V_Warning,V_Normal,V_Debug);
+
+  TConfig = record
+    NeedOptions,
+    NeedCPU,
+    NeedVersion,
+    KnownRunNote  : string;
+    ResultCode    : longint;
+    KnownRunError : longint;
+    NeedRecompile : boolean;
+    NeedLibrary   : boolean;
+    IsInteractive : boolean;
+    IsKnown       : boolean;
+    NoRun         : boolean;
+    UsesGraph     : boolean;
+    ShouldFail    : boolean;
+    Category      : string;
+    Note          : string;
+  end;
+
+Const
+  DoVerbose : boolean = false;
+  
+procedure TrimB(var s:string);
+procedure TrimE(var s:string);
+function upper(const s : string) : string;
+procedure Verbose(lvl:TVerboseLevel;const s:string);
+function GetConfig(const fn:string;var r:TConfig):boolean;
+Function GetFileContents (FN : String) : String;
+
+Implementation
+
+procedure Verbose(lvl:TVerboseLevel;const s:string);
+begin
+  case lvl of
+    V_Normal :
+      writeln(s);
+    V_Debug :
+      if DoVerbose then
+       writeln('Debug: ',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;
+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
+  L:=Length(S);
+  SetLength(upper,l);
+  for i:=1 to l do
+    if s[i] in ['a'..'z'] then
+     upper[i]:=char(byte(s[i])-32)
+    else
+     upper[i]:=s[i];
+end;
+
+function GetConfig(const fn:string;var r:TConfig):boolean;
+var
+  t : text;
+  part,code : integer;
+  l : longint;
+  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 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('CPU') then
+                r.NeedCPU:=res
+              else
+               if GetEntry('VERSION') then
+                r.NeedVersion:=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
+                r.NeedRecompile:=true
+              else
+               if GetEntry('NORUN') then
+                r.NoRun:=true
+              else
+               if GetEntry('NEEDLIBRARY') then
+                r.NeedLibrary:=true
+              else
+               if GetEntry('KNOWNRUNERROR') then
+                begin
+                  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('KNOWN') then
+                 r.IsKnown:=true
+              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
+               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);
+    Result:=Result+S+LineEnding;
+    end;
+  Close(F);  
+end;
+
+end.