paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-27 07:31:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revisions 149-150 via svnmerge from

Browse Source 
/trunk

git-svn-id: branches/fixes_2_0@364 -
This commit is contained in:
peter 2005-06-10 07:55:51 +00:00
parent 3731568314
commit b4089ca3c6
2 changed files with 40 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
tests/utils/dbdigest.pp
View File

@ -146,12 +146,8 @@ Const
Var
StatusCount : Array[TTestStatus] of Integer;
UnknownLines,
unexpected_run : Integer;
next_should_be_run : boolean;
UnknownLines : integer;
var
prevline : string;
Procedure ExtractTestFileName(Var Line : string);
@ -167,7 +163,6 @@ Function Analyse(Var Line : string; Var Status : TTestStatus) : Boolean;
Var
TS : TTestStatus;
Found : Boolean;
begin
Result:=False;
@ -198,7 +193,9 @@ TConfigOpt = (
coDate,
coSubmitter,
coMachine,
coComment
coComment,
coTestSrcDir,
coVerbose
);
Const
@ -215,11 +212,13 @@ ConfigStrings : Array [TConfigOpt] of string = (
'date',
'submitter',
'machine',
'comment'
'comment',
'testsrcdir',
'verbose'
);
ConfigOpts : Array[TConfigOpt] of char
= ('d','h','u','p','l','o','c','v','t','s','m','C');
= ('d','h','u','p','l','o','c','v','t','s','m','C','S','V');
Var
TestOS,
@ -236,7 +235,8 @@ Var
TestDate : TDateTime;
Procedure SetOpt (O : TConfigOpt; Value : string);
var
year,month,day,min,hour : word;
begin
Case O of
coDatabaseName : DatabaseName:=Value;
@ -247,10 +247,31 @@ begin
coOS : TestOS:=Value;
coCPU : TestCPU:=Value;
coVersion : TestVersion:=Value;
coDate : TestDate:=StrToDate(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;
end;
end;
@ -259,8 +280,7 @@ Function ProcessOption(S: String) : Boolean;
Var
N : String;
I : Integer;
Found : Boolean;
co,o : TConfigOpt;
co : TConfigOpt;
begin
Verbose(V_DEBUG,'Processing option: '+S);
@ -274,10 +294,7 @@ begin
begin
Result:=CompareText(ConfigStrings[co],N)=0;
If Result then
begin
o:=co;
Break;
end;
end;
end;
If Result then
@ -320,7 +337,7 @@ Procedure ProcessCommandLine;
Var
I : Integer;
O,V : String;
O : String;
c,co : TConfigOpt;
Found : Boolean;
@ -452,7 +469,7 @@ procedure UpdateTestRun;
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"',[Submitter,Machine,Comment]);
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;

6
tests/utils/dbtests.pp
View File

@ -48,6 +48,9 @@ Function IDQuery(Qry : String) : Integer;
Function EscapeSQL( S : String) : String;
Function SQLDate(D : TDateTime) : String;
var
TestSrcDir : string;
Implementation
Uses
@ -257,7 +260,8 @@ Var
begin
Result:=-1;
If FileExists(Name) and GetConfig(Name,Info) then
If FileExists(TestSrcDir+Name) and
GetConfig(TestSrcDir+Name,Info) then
begin
If RunQuery(Format(SInsertTest,[ExtractFileName(Name),Name]),Res) then
begin