paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 08:49:25 +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

47
tests/utils/dbdigest.pp
View File

@ -400,13 +400,15 @@ Procedure Processfile (FN: String);
var var
logfile : text; logfile : text;
line : string; line,prevLine : string;
TS : TTestStatus; TS,PrevTS : TTestStatus;
ID : integer; ID,PrevID : integer;
Testlog : string; Testlog : string;
begin begin
Assign(logfile,FN); Assign(logfile,FN);
PrevId:=-1;
PrevLine:='';
PrevTS:=low(TTestStatus);
{$i-} {$i-}
reset(logfile); reset(logfile);
if ioresult<>0 then if ioresult<>0 then
@ -418,10 +420,19 @@ begin
If analyse(line,TS) then If analyse(line,TS) then
begin begin
Verbose(V_NORMAL,'Analysing result for test '+Line); Verbose(V_NORMAL,'Analysing result for test '+Line);
Inc(StatusCount[TS]);
If Not ExpectRun[TS] then If Not ExpectRun[TS] then
begin begin
ID:=RequireTestID(Line); 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 If (ID<>-1) then
begin begin
If Not (TestOK[TS] or TestSkipped[TS]) then If Not (TestOK[TS] or TestSkipped[TS]) then
@ -432,12 +443,34 @@ begin
end end
else else
TestLog:=''; TestLog:='';
AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],TestSkipped[TS],TestLog); { 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;
end end
else
begin
Inc(StatusCount[TS]);
PrevTS:=TS;
PrevID:=RequireTestID(line);
PrevLine:=line;
end;
end end
else else
Inc(UnknownLines); begin
Inc(UnknownLines);
Verbose(V_Warning,'Unknown line: "'+line+'"');
end;
end; end;
close(logfile); close(logfile);
end; end;

22
tests/utils/dbtests.pp
View File

@ -162,9 +162,9 @@ end;
Function EscapeSQL( S : String) : String; Function EscapeSQL( S : String) : String;
begin begin
Result:=StringReplace(S,'"','\"',[rfReplaceAll]); Result:=StringReplace(S,'\','\\',[rfReplaceAll]);
Result:=StringReplace(Result,'"','\"',[rfReplaceAll]);
Verbose(V_DEBUG,'EscapeSQL : "'+S+'" -> "'+Result+'"'); Verbose(V_DEBUG,'EscapeSQL : "'+S+'" -> "'+Result+'"');
end; end;
@ -414,10 +414,10 @@ Function AddTestResult(TestID,RunID,TestRes : Integer;
Const Const
SInsertRes='Insert into TESTRESULTS '+ 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 '+ ' VALUES '+
'(%d,%d,"%s","%s",%d,"%s") '; '(%d,%d,"%s","%s",%d) ';
SInsertLog='Update TESTRESULTS SET TR_LOG="%s" WHERE (TR_ID=%d)';
Var Var
Qry : String; Qry : String;
Res : TQueryResult; Res : TQueryResult;
@ -427,7 +427,17 @@ begin
Qry:=Format(SInsertRes, Qry:=Format(SInsertRes,
[TestID,RunID,B[OK],B[Skipped],TestRes,EscapeSQL(Log)]); [TestID,RunID,B[OK],B[Skipped],TestRes,EscapeSQL(Log)]);
If RunQuery(Qry,Res) then 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; end;
Function RequireTestID(Name : String): Integer; Function RequireTestID(Name : String): Integer;