mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-02 06:29:25 +01:00
+ Added dbdigest to store results in a database
This commit is contained in:
michael
parent
021f0c9f6f
commit
45eff4e71b
@ -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)),)
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
415
tests/utils/dbdigest.pp
Normal file
415
tests/utils/dbdigest.pp
Normal file
@ -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
|
||||
|
||||
}
|
||||
292
tests/utils/dbtests.pp
Normal file
292
tests/utils/dbtests.pp
Normal file
@ -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.
|
||||
@ -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
|
||||
|
||||
72
tests/utils/tests.sql
Normal file
72
tests/utils/tests.sql
Normal file
@ -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');
|
||||
|
||||
|
||||
249
tests/utils/testu.pp
Normal file
249
tests/utils/testu.pp
Normal file
@ -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.
|
||||
Loading…
Reference in New Issue
Block a user