mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-04 18:38:21 +02:00
test: initial files to import test results into test result database, mostly copied from the fpc import utility
git-svn-id: trunk@16067 -
This commit is contained in:
vincents
parent
6a34f588ad
commit
f42e5ac169
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -3744,9 +3744,13 @@ test/runtestsgui.lpr svneol=native#text/plain
|
||||
test/testglobals.pas svneol=native#text/plain
|
||||
test/testlpi.pas svneol=native#text/plain
|
||||
test/testresult-db/createdb.sql svneol=native#text/plain
|
||||
test/testresult-db/dbtests.pp svneol=native#text/plain
|
||||
test/testresult-db/importtestresults.lpi svneol=native#text/plain
|
||||
test/testresult-db/importtestresults.pp svneol=native#text/plain
|
||||
test/testresult-db/teststr.pp svneol=native#text/plain
|
||||
test/testresult-db/testsuite.lpi svneol=native#text/plain
|
||||
test/testresult-db/testsuite.pp svneol=native#text/plain
|
||||
test/testresult-db/testu.pp svneol=native#text/plain
|
||||
test/testresult-db/tresults.pp svneol=native#text/plain
|
||||
test/testresult-db/utests.pp svneol=native#text/plain
|
||||
test/testunits.pas svneol=native#text/plain
|
||||
|
||||
448
test/testresult-db/dbtests.pp
Normal file
448
test/testresult-db/dbtests.pp
Normal file
@ -0,0 +1,448 @@
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
unit dbtests;
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
{$ifndef ver1_0}
|
||||
mysql4,
|
||||
{$else}
|
||||
mysql,
|
||||
{$endif}
|
||||
testu;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
High-level access
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function GetTestID(Name : string) : Integer;
|
||||
Function GetOSID(Name : String) : Integer;
|
||||
Function GetCPUID(Name : String) : Integer;
|
||||
Function GetCategoryID(Name : String) : Integer;
|
||||
Function GetVersionID(Name : String) : Integer;
|
||||
Function GetRunID(OSID, CPUID, VERSIONID : Integer; Date : TDateTime) : Integer;
|
||||
Function AddRun(OSID, CPUID, VERSIONID, CATEGORYID : Integer; Date : TDateTime) : Integer;
|
||||
Function AddTest(Name : String; AddSource : Boolean) : Integer;
|
||||
Function UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
|
||||
Function AddTestResult(TestID,RunID,TestRes : Integer;
|
||||
OK, Skipped : Boolean;
|
||||
Log : String) : Integer;
|
||||
Function RequireTestID(Name : String): Integer;
|
||||
Function CleanTestRun(ID : Integer) : Boolean;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
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;
|
||||
Function SQLDate(D : TDateTime) : String;
|
||||
|
||||
var
|
||||
RelSrcDir,
|
||||
TestSrcDir : 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);
|
||||
{$ifdef ver1_0}
|
||||
Result:=mysql_connect(@Connection,PChar(Host),PChar(User),PChar(Password))<>Nil;
|
||||
{$else}
|
||||
mysql_init(@Connection);
|
||||
Result:=mysql_real_connect(@Connection,PChar(Host),PChar(User),PChar(Password),Nil,0,Nil,0)<>Nil;
|
||||
{$endif}
|
||||
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;
|
||||
|
||||
|
||||
Function SQLDate(D : TDateTime) : String;
|
||||
|
||||
begin
|
||||
Result:=FormatDateTime('YYYY/MM/DD hh:nn:ss',D);
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
High-level access
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
Function GetTestID(Name : string) : Integer;
|
||||
|
||||
Const
|
||||
SFromName = 'SELECT T_ID FROM TESTS WHERE (T_NAME="%s")';
|
||||
|
||||
begin
|
||||
Result:=IDQuery(Format(SFromName,[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 GetVersionID(Name : String) : Integer;
|
||||
|
||||
Const
|
||||
SFromName = 'SELECT TV_ID FROM TESTVERSION WHERE (TV_VERSION="%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 GetCategoryID(Name : String) : Integer;
|
||||
|
||||
Const
|
||||
SFromName = 'SELECT TCAT_ID FROM TESTCATEGORY WHERE (TCAT_NAME="%s")';
|
||||
|
||||
begin
|
||||
Result:=IDQuery(Format(SFromName,[Name]));
|
||||
end;
|
||||
|
||||
Function GetRunID(OSID, CPUID, VERSIONID : Integer; Date : TDateTime) : Integer;
|
||||
|
||||
|
||||
Const
|
||||
SFromIDS = 'SELECT TU_ID FROM TESTRUN WHERE '+
|
||||
' (TU_OS_FK=%d) '+
|
||||
' AND (TU_CPU_FK=%d) '+
|
||||
' AND (TU_VERSION_FK=%d) '+
|
||||
' AND (TU_DATE="%s")';
|
||||
|
||||
begin
|
||||
Result:=IDQuery(Format(SFromIDS,[OSID,CPUID,VERSIONID,SQLDate(Date)]));
|
||||
end;
|
||||
|
||||
Function AddRun(OSID, CPUID, VERSIONID, CATEGORYID : Integer; Date : TDateTime) : Integer;
|
||||
|
||||
Const
|
||||
SInsertRun = 'INSERT INTO TESTRUN '+
|
||||
'(TU_OS_FK,TU_CPU_FK,TU_VERSION_FK,TU_CATEGORY_FK,TU_DATE)'+
|
||||
' VALUES '+
|
||||
'(%d,%d,%d,%d,"%s")';
|
||||
|
||||
Var
|
||||
Res : TQueryResult;
|
||||
|
||||
begin
|
||||
If RunQuery(Format(SInsertRun,[OSID,CPUID,VERSIONID,CATEGORYID,SQLDate(Date)]),Res) then
|
||||
Result:=mysql_insert_id(@connection)
|
||||
else
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
function posr(c : Char; const s : AnsiString) : integer;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
i := length(s);
|
||||
while (i>0) and (s[i] <> c) do dec(i);
|
||||
Result := i;
|
||||
end;
|
||||
|
||||
function GetUnitTestConfig(const fn : string; var r : TConfig) : Boolean;
|
||||
var
|
||||
Path : string;
|
||||
ClassName : string;
|
||||
MethodName : string;
|
||||
slashpos : integer;
|
||||
FileName : string;
|
||||
s : string;
|
||||
t : text;
|
||||
begin
|
||||
Result := False;
|
||||
FillChar(r,sizeof(r),0);
|
||||
if pos('.',fn) > 0 then exit; // This is normally not a unit-test
|
||||
slashpos := posr('/',fn);
|
||||
if slashpos < 1 then exit;
|
||||
MethodName := copy(fn,slashpos+1,length(fn));
|
||||
Path := copy(fn,1,slashpos-1);
|
||||
slashpos := posr('/',Path);
|
||||
if slashpos > 0 then
|
||||
begin
|
||||
ClassName := copy(Path,slashpos+1,length(Path));
|
||||
Path := copy(Path,1,slashpos-1);
|
||||
end
|
||||
else
|
||||
begin
|
||||
ClassName := Path;
|
||||
path := '.';
|
||||
end;
|
||||
if upper(ClassName[1])<>'T' then exit;
|
||||
FileName := TestSrcDir+RelSrcDir+Path+DirectorySeparator+copy(lowercase(ClassName),2,length(classname));
|
||||
if FileExists(FileName+'.pas') then
|
||||
FileName := FileName + '.pas'
|
||||
else if FileExists(FileName+'.pp') then
|
||||
FileName := FileName + '.pp'
|
||||
else exit;
|
||||
|
||||
Verbose(V_Debug,'Reading '+FileName);
|
||||
assign(t,FileName);
|
||||
{$I-}
|
||||
reset(t);
|
||||
{$I+}
|
||||
if ioresult<>0 then
|
||||
begin
|
||||
Verbose(V_Error,'Can''t open '+FileName);
|
||||
exit;
|
||||
end;
|
||||
while not eof(t) do
|
||||
begin
|
||||
readln(t,s);
|
||||
|
||||
if s<>'' then
|
||||
begin
|
||||
TrimB(s);
|
||||
if SameText(copy(s,1,9),'PROCEDURE') then
|
||||
begin
|
||||
if pos(';',s)>11 then
|
||||
begin
|
||||
s := copy(s,11,pos(';',s)-11);
|
||||
TrimB(s);
|
||||
if SameText(s,ClassName+'.'+MethodName) then
|
||||
begin
|
||||
Result := True;
|
||||
r.Note:= 'unittest';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
close(t);
|
||||
end;
|
||||
|
||||
Function AddTest(Name : String; AddSource : Boolean) : Integer;
|
||||
|
||||
Const
|
||||
SInsertTest = 'INSERT INTO TESTS (T_NAME,T_ADDDATE)'+
|
||||
' VALUES ("%s",NOW())';
|
||||
|
||||
Var
|
||||
Info : TConfig;
|
||||
Res : TQueryResult;
|
||||
|
||||
begin
|
||||
Result:=-1;
|
||||
If (FileExists(TestSrcDir+RelSrcDir+Name) and
|
||||
GetConfig(TestSrcDir+RelSrcDir+Name,Info)) or
|
||||
GetUnitTestConfig(Name,Info) then
|
||||
begin
|
||||
If RunQuery(Format(SInsertTest,[Name]),Res) then
|
||||
begin
|
||||
Result:=GetTestID(Name);
|
||||
If Result=-1 then
|
||||
Verbose(V_WARNING,'Could not find newly added test!')
|
||||
else
|
||||
If AddSource then
|
||||
UpdateTest(Result,Info,GetFileContents(Name))
|
||||
else
|
||||
UpdateTest(Result,Info,'');
|
||||
end
|
||||
end
|
||||
else
|
||||
Verbose(V_ERROR,'Could not find test "'+Name+'" or info about this test.');
|
||||
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(MinVersion),
|
||||
B[usesGraph],B[IsInteractive],ResultCode,
|
||||
B[ShouldFail],B[NeedRecompile],B[NoRun],
|
||||
B[NeedLibrary],KnownRunError,
|
||||
B[IsKnownCompileError],EscapeSQL(Note),EscapeSQL(NeedOptions),
|
||||
Source,
|
||||
ID
|
||||
]);
|
||||
Result:=RunQuery(Qry,res)
|
||||
end;
|
||||
|
||||
Function AddTestResult(TestID,RunID,TestRes : Integer;
|
||||
OK, Skipped : Boolean;
|
||||
Log : String) : Integer;
|
||||
|
||||
Const
|
||||
SInsertRes='Insert into TESTRESULTS '+
|
||||
'(TR_TEST_FK,TR_TESTRUN_FK,TR_OK,TR_SKIP,TR_RESULT,TR_LOG) '+
|
||||
' VALUES '+
|
||||
'(%d,%d,"%s","%s",%d,"%s") ';
|
||||
|
||||
Var
|
||||
Qry : String;
|
||||
Res : TQueryResult;
|
||||
|
||||
begin
|
||||
Result:=-1;
|
||||
Qry:=Format(SInsertRes,
|
||||
[TestID,RunID,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;
|
||||
|
||||
Function CleanTestRun(ID : Integer) : Boolean;
|
||||
|
||||
Const
|
||||
SDeleteRun = 'DELETE FROM TESTRESULTS WHERE TR_TESTRUN_FK=%d';
|
||||
|
||||
Var
|
||||
Res : TQueryResult;
|
||||
|
||||
begin
|
||||
Result:=RunQuery(Format(SDeleteRun,[ID]),Res);
|
||||
end;
|
||||
|
||||
end.
|
||||
137
test/testresult-db/importtestresults.lpi
Normal file
137
test/testresult-db/importtestresults.lpi
Normal file
@ -0,0 +1,137 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="\"/>
|
||||
<Version Value="6"/>
|
||||
<General>
|
||||
<MainUnit Value="0"/>
|
||||
<TargetFileExt Value=".exe"/>
|
||||
<ActiveEditorIndexAtStart Value="2"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
<Language Value=""/>
|
||||
<CharSet Value=""/>
|
||||
</VersionInfo>
|
||||
<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)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="importtestresults.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="importtestresuls"/>
|
||||
<CursorPos X="25" Y="20"/>
|
||||
<TopLine Value="7"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="20"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="teststr.pp"/>
|
||||
<UnitName Value="teststr"/>
|
||||
<CursorPos X="45" Y="37"/>
|
||||
<TopLine Value="8"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<UsageCount Value="10"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="testu.pp"/>
|
||||
<UnitName Value="testu"/>
|
||||
<CursorPos X="1" Y="37"/>
|
||||
<TopLine Value="37"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="10"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
<JumpHistory Count="2" HistoryIndex="1">
|
||||
<Position1>
|
||||
<Filename Value="teststr.pp"/>
|
||||
<Caret Line="1" Column="1" TopLine="1"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="testu.pp"/>
|
||||
<Caret Line="1" Column="1" TopLine="1"/>
|
||||
</Position2>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<PathDelim Value="\"/>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<BreakPoints Count="11">
|
||||
<Item1>
|
||||
<Source Value="..\..\ide\compileroptions.pp"/>
|
||||
<InitialEnabled Value="False"/>
|
||||
<Line Value="1695"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Source Value="..\..\ide\ideprocs.pp"/>
|
||||
<Line Value="1396"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Source Value="..\..\ide\compileroptionsdlg.pp"/>
|
||||
<Line Value="1656"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Source Value="..\..\lcl\include\fileutil.inc"/>
|
||||
<InitialEnabled Value="False"/>
|
||||
<Line Value="210"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Source Value="..\..\ide\condef.pas"/>
|
||||
<Line Value="148"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Source Value="..\..\lcl\include\treeview.inc"/>
|
||||
<Line Value="3949"/>
|
||||
</Item6>
|
||||
<Item7>
|
||||
<Source Value="..\..\components\synedit\synedit.pp"/>
|
||||
<Line Value="6322"/>
|
||||
</Item7>
|
||||
<Item8>
|
||||
<Source Value="..\..\components\synedit\synedit.pp"/>
|
||||
<Line Value="2189"/>
|
||||
</Item8>
|
||||
<Item9>
|
||||
<Source Value="..\..\ide\editoroptions.pp"/>
|
||||
<Line Value="3621"/>
|
||||
</Item9>
|
||||
<Item10>
|
||||
<Source Value="..\..\ide\main.pp"/>
|
||||
<Line Value="3257"/>
|
||||
</Item10>
|
||||
<Item11>
|
||||
<Source Value="..\..\ide\main.pp"/>
|
||||
<Line Value="3256"/>
|
||||
</Item11>
|
||||
</BreakPoints>
|
||||
<Watches Count="2">
|
||||
<Item1>
|
||||
<Expression Value="MainUnitInfo.FSource.FSource"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Expression Value="FOnCompare"/>
|
||||
</Item2>
|
||||
</Watches>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
412
test/testresult-db/importtestresults.pp
Normal file
412
test/testresult-db/importtestresults.pp
Normal file
@ -0,0 +1,412 @@
|
||||
{
|
||||
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 importtestresults;
|
||||
|
||||
uses
|
||||
sysutils,teststr,testu,tresults,dbtests;
|
||||
|
||||
|
||||
Var
|
||||
StatusCount : Array[TTestStatus] of Integer;
|
||||
UnknownLines : integer;
|
||||
|
||||
|
||||
Procedure ExtractTestFileName(Var Line : string);
|
||||
|
||||
Var I : integer;
|
||||
|
||||
begin
|
||||
I:=Pos(' ',Line);
|
||||
If (I<>0) then
|
||||
Line:=Copy(Line,1,I-1);
|
||||
end;
|
||||
|
||||
Function Analyse(Var Line : string; Var Status : TTestStatus) : Boolean;
|
||||
|
||||
Var
|
||||
TS : TTestStatus;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
For TS:=FirstStatus to LastStatus do
|
||||
begin
|
||||
Result:=Pos(StatusText[TS],Line)=1;
|
||||
If Result then
|
||||
begin
|
||||
Status:=TS;
|
||||
Delete(Line,1,Length(StatusText[TS]));
|
||||
ExtractTestFileName(Line);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Type
|
||||
|
||||
TConfigOpt = (
|
||||
coDatabaseName,
|
||||
soHost,
|
||||
coUserName,
|
||||
coPassword,
|
||||
coLogFile,
|
||||
coOS,
|
||||
coCPU,
|
||||
coCategory,
|
||||
coVersion,
|
||||
coDate,
|
||||
coSubmitter,
|
||||
coMachine,
|
||||
coComment,
|
||||
coTestSrcDir,
|
||||
coRelSrcDir,
|
||||
coVerbose
|
||||
);
|
||||
|
||||
Const
|
||||
|
||||
ConfigStrings : Array [TConfigOpt] of string = (
|
||||
'databasename',
|
||||
'host',
|
||||
'username',
|
||||
'password',
|
||||
'logfile',
|
||||
'os',
|
||||
'cpu',
|
||||
'widgetset',
|
||||
'category',
|
||||
'version',
|
||||
'date',
|
||||
'submitter',
|
||||
'machine',
|
||||
'comment',
|
||||
'testsrcdir',
|
||||
'relsrcdir',
|
||||
'verbose'
|
||||
);
|
||||
|
||||
ConfigOpts : Array[TConfigOpt] of char
|
||||
= ('d','h','u','p','l','o','c','w','a','v','t','s','m','C','S','r','V');
|
||||
|
||||
Var
|
||||
TestOS,
|
||||
TestCPU,
|
||||
TestVersion,
|
||||
TestCategory,
|
||||
DatabaseName,
|
||||
HostName,
|
||||
UserName,
|
||||
Password,
|
||||
ResultsFileName,
|
||||
Submitter,
|
||||
Machine,
|
||||
Comment : String;
|
||||
TestDate : TDateTime;
|
||||
|
||||
Procedure SetOpt (O : TConfigOpt; Value : string);
|
||||
var
|
||||
year,month,day,min,hour : word;
|
||||
begin
|
||||
Case O of
|
||||
coDatabaseName : DatabaseName:=Value;
|
||||
soHost : HostName:=Value;
|
||||
coUserName : UserName:=Value;
|
||||
coPassword : Password:=Value;
|
||||
coLogFile : ResultsFileName:=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;
|
||||
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;
|
||||
|
||||
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
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
If Result then
|
||||
SetOpt(co,S)
|
||||
else
|
||||
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;
|
||||
Found : Boolean;
|
||||
|
||||
begin
|
||||
I:=1;
|
||||
While I<=ParamCount do
|
||||
begin
|
||||
O:=Paramstr(I);
|
||||
Found:=Length(O)=2;
|
||||
If Found 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 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;
|
||||
TestVersionID : Integer;
|
||||
TestCategoryID : Integer;
|
||||
TestRunID : 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.');
|
||||
TestCategoryID := GetCategoryID(TestCategory);
|
||||
If TestCategoryID=-1 then
|
||||
begin
|
||||
// Verbose(V_Error,'NO ID for Category "'+TestCategory+'" found.');
|
||||
TestCategoryID:=1;
|
||||
end;
|
||||
TestVersionID := GetVersionID(TestVersion);
|
||||
If TestVersionID=-1 then
|
||||
Verbose(V_Error,'NO ID for version "'+TestVersion+'" found.');
|
||||
If (Round(TestDate)=0) then
|
||||
Testdate:=Now;
|
||||
TestRunID:=GetRunID(TestOSID,TestCPUID,TestVersionID,TestDate);
|
||||
If (TestRunID=-1) then
|
||||
begin
|
||||
TestRunID:=AddRun(TestOSID,TestCPUID,TestVersionID,TestCategoryID,TestDate);
|
||||
If TestRUnID=-1 then
|
||||
Verbose(V_Error,'Could not insert new testrun record!');
|
||||
end
|
||||
else
|
||||
CleanTestRun(TestRunID);
|
||||
end;
|
||||
|
||||
Function GetLog(FN : String) : String;
|
||||
|
||||
begin
|
||||
FN:=ChangeFileExt(FN,'.log');
|
||||
If FileExists(FN) then
|
||||
Result:=GetFileContents(FN)
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
Function GetExecuteLog(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'+ResultsFileName);
|
||||
{$i+}
|
||||
while not eof(logfile) do
|
||||
begin
|
||||
readln(logfile,line);
|
||||
If analyse(line,TS) then
|
||||
begin
|
||||
Verbose(V_NORMAL,'Analysing result for test '+Line);
|
||||
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
|
||||
begin
|
||||
TestLog:=GetExecuteLog(Line);
|
||||
if pos(failed_to_compile,TestLog)=1 then
|
||||
TestLog:=GetLog(Line);
|
||||
end
|
||||
else
|
||||
TestLog:='';
|
||||
AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],TestSkipped[TS],TestLog);
|
||||
end;
|
||||
end
|
||||
end
|
||||
else
|
||||
Inc(UnknownLines);
|
||||
end;
|
||||
close(logfile);
|
||||
end;
|
||||
|
||||
procedure ProcessResultsFile;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure UpdateTestRun;
|
||||
|
||||
var
|
||||
i : TTestStatus;
|
||||
qry : string;
|
||||
res : TQueryResult;
|
||||
|
||||
begin
|
||||
qry:='UPDATE TESTRUN SET ';
|
||||
for i:=low(TTestStatus) to high(TTestStatus) do
|
||||
qry:=qry+format('%s=%d, ',[SQLField[i],StatusCount[i]]);
|
||||
qry:=qry+format('TU_SUBMITTER="%s", TU_MACHINE="%s", TU_COMMENT="%s", TU_DATE="%s"',[Submitter,Machine,Comment,SqlDate(TestDate)]);
|
||||
qry:=qry+' WHERE TU_ID='+format('%d',[TestRunID]);
|
||||
RunQuery(Qry,res)
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
ProcessConfigFile('dbdigest.cfg');
|
||||
ProcessCommandLine;
|
||||
If ResultsFileName<>'' then
|
||||
begin
|
||||
ConnectToDatabase(DatabaseName,HostName,UserName,Password);
|
||||
GetIDs;
|
||||
ProcessResultsFile(ResultsFileName);
|
||||
UpdateTestRun;
|
||||
end
|
||||
else
|
||||
Verbose(V_ERROR,'Missing log file name');
|
||||
end.
|
||||
300
test/testresult-db/testu.pp
Normal file
300
test/testresult-db/testu.pp
Normal file
@ -0,0 +1,300 @@
|
||||
{$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,
|
||||
SkipCPU,
|
||||
SkipEmu,
|
||||
NeedTarget,
|
||||
SkipTarget,
|
||||
MinVersion,
|
||||
MaxVersion,
|
||||
KnownRunNote,
|
||||
KnownCompileNote : string;
|
||||
ResultCode : longint;
|
||||
KnownRunError : longint;
|
||||
KnownCompileError : longint;
|
||||
NeedRecompile : boolean;
|
||||
NeedLibrary : boolean;
|
||||
IsInteractive : boolean;
|
||||
IsKnownRunError,
|
||||
IsKnownCompileError : boolean;
|
||||
NoRun : boolean;
|
||||
UsesGraph : boolean;
|
||||
ShouldFail : boolean;
|
||||
Timeout : longint;
|
||||
Category : string;
|
||||
Note : string;
|
||||
Files : 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 Copy(s,1,3)=#$EF#$BB#$BF then
|
||||
delete(s,1,3);
|
||||
if s<>'' then
|
||||
begin
|
||||
TrimB(s);
|
||||
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('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
|
||||
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
|
||||
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
|
||||
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