paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 14:29:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Improve test result insertion into database

Browse Source 
git-svn-id: trunk@14804 -
This commit is contained in:
pierre 2010-01-25 16:51:50 +00:00
parent a527b6b2b4
commit 85fef0d52d
2 changed files with 56 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
tests/utils/dbdigest.pp
View File

@ -400,13 +400,15 @@ Procedure Processfile (FN: String);
var
logfile : text;
line : string;
TS : TTestStatus;
ID : integer;
line,prevLine : string;
TS,PrevTS : TTestStatus;
ID,PrevID : integer;
Testlog : string;
begin
Assign(logfile,FN);
PrevId:=-1;
PrevLine:='';
PrevTS:=low(TTestStatus);
{$i-}
reset(logfile);
if ioresult<>0 then
@ -418,10 +420,19 @@ begin
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 (PrevID<>-1) and (PrevID<>ID) then
begin
{ This can only happen if a Successfully compiled message
is not followed by any other line about the same test }
TestLog:='';
AddTestResult(PrevID,TestRunId,ord(PrevTS),
TestOK[PrevTS],TestSkipped[PrevTS],TestLog);
Verbose(V_Warning,'Orphaned test: "'+prevline+'"');
end;
PrevID:=-1;
If (ID<>-1) then
begin
If Not (TestOK[TS] or TestSkipped[TS]) then
@ -432,12 +443,34 @@ begin
end
else
TestLog:='';
AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],TestSkipped[TS],TestLog);
end;
end
{ AddTestResult can fail for test that contain %recompile
as the same }
if AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],
TestSkipped[TS],TestLog) <> -1 then
begin
Inc(StatusCount[TS]);
end
else
begin
Verbose(V_Warning,'Test: "'+line+'" already registered');
end;
end;
end
else
begin
Inc(StatusCount[TS]);
PrevTS:=TS;
PrevID:=RequireTestID(line);
PrevLine:=line;
end;
end
else
begin
Inc(UnknownLines);
Verbose(V_Warning,'Unknown line: "'+line+'"');
end;
end;
close(logfile);
end;

22
tests/utils/dbtests.pp
View File

@ -162,9 +162,9 @@ end;
Function EscapeSQL( S : String) : String;
begin
Result:=StringReplace(S,'"','\"',[rfReplaceAll]);
Result:=StringReplace(S,'\','\\',[rfReplaceAll]);
Result:=StringReplace(Result,'"','\"',[rfReplaceAll]);
Verbose(V_DEBUG,'EscapeSQL : "'+S+'" -> "'+Result+'"');
end;
@ -414,10 +414,10 @@ Function AddTestResult(TestID,RunID,TestRes : Integer;
Const
SInsertRes='Insert into TESTRESULTS '+
'(TR_TEST_FK,TR_TESTRUN_FK,TR_OK,TR_SKIP,TR_RESULT,TR_LOG) '+
'(TR_TEST_FK,TR_TESTRUN_FK,TR_OK,TR_SKIP,TR_RESULT) '+
' VALUES '+
'(%d,%d,"%s","%s",%d,"%s") ';
'(%d,%d,"%s","%s",%d) ';
SInsertLog='Update TESTRESULTS SET TR_LOG="%s" WHERE (TR_ID=%d)';
Var
Qry : String;
Res : TQueryResult;
@ -427,7 +427,17 @@ begin
Qry:=Format(SInsertRes,
[TestID,RunID,B[OK],B[Skipped],TestRes,EscapeSQL(Log)]);
If RunQuery(Qry,Res) then
Result:=mysql_insert_id(@connection);
Result:=mysql_insert_id(@connection)
else
Verbose(V_Warning,'AddTestResult failed');
if (Result<>-1) and (Log<>'') then
begin
Qry:=format(SInsertLog,[EscapeSQL(Log),Result]);
if not RunQuery(Qry,Res) then
begin
Verbose(V_Warning,'Insert Log failed');
end;
end;
end;
Function RequireTestID(Name : String): Integer;