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

test results: implemented showing failure message.

Browse Source 
git-svn-id: trunk@16112 -
This commit is contained in:
vincents 2008-08-18 10:45:55 +00:00
parent 520a6b0648
commit 0664276f37
2 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
test/testresult-db/importtestresults.pp
View File

@ -454,21 +454,22 @@ procedure ProcessTestListing;
procedure ProcessTest(ATestElement: TDOMElement; APath: string); procedure ProcessTest(ATestElement: TDOMElement; APath: string);
var var
Name, FullName: string; Name, FullName: string;
TestResult: string; TestResult, TestLog: string;
TS: TTestStatus; TS: TTestStatus;
ID: LongInt; ID: LongInt;
i: Integer; i: Integer;
begin begin
Name := ATestElement.GetAttribute('Name'); Name := ATestElement.GetAttribute('Name');
TestResult := ATestElement.GetAttribute('Result'); TestResult := ATestElement.GetAttribute('Result');
TestLog := '';
Verbose(V_NORMAL,'Analysing result for test '+Name); Verbose(V_NORMAL,'Analysing result for test '+Name);
for i := 0 to ATestElement.Attributes.Length-1 do
Verbose(V_NORMAL,ATestElement.Attributes[i].NodeName+ '=' + ATestElement.Attributes[i].NodeValue);
FullName := APath + '|' + Name; FullName := APath + '|' + Name;
ID := RequireTestID(FullName); ID := RequireTestID(FullName);
TS:=GetTestStatus(TestResult); TS:=GetTestStatus(TestResult);
Verbose(V_Debug,'Test result: '+TestResult+' TestStatus: '+IntToStr(ord(TS))); Verbose(V_Debug,'Test result: '+TestResult+' TestStatus: '+IntToStr(ord(TS)));
AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],TestSkipped[TS],'No log yet'); if TS=stFailed then
TestLog := ATestElement.FindNode('Message').TextContent;
AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],TestSkipped[TS],TestLog);
end; end;
procedure ProcessNodes(AParentNode: TDomNode; APath: string); procedure ProcessNodes(AParentNode: TDomNode; APath: string);

11
test/testresult-db/utests.pp
View File

@ -80,7 +80,6 @@ Type
Procedure ShowRunOverview; Procedure ShowRunOverview;
Procedure CreateRunPie; Procedure CreateRunPie;
Function ShowRunData : Boolean; Function ShowRunData : Boolean;
end; end;
implementation implementation
@ -857,6 +856,14 @@ Var
FieldName,FieldValue, FieldName,FieldValue,
Log,Source : String; Log,Source : String;
Res : Boolean; Res : Boolean;
function MyEscapeHTML(const AText: string): string;
begin
// replace by a more sensitive method.
Result:=StringReplace(AText,'&','&',[rfReplaceAll]);
Result:=StringReplace(Result,'<','&lt;',[rfReplaceAll]);
Result:=StringReplace(Result,'>','&gt;',[rfReplaceAll]);
Result:=StringReplace(Result,#10,'<BR>',[rfreplaceAll]);
end;
begin begin
ConnectToDB; ConnectToDB;
ContentType:='text/html'; ContentType:='text/html';
@ -999,7 +1006,7 @@ begin
Write('Log of '+FRunId+':'); Write('Log of '+FRunId+':');
HeaderEnd(2); HeaderEnd(2);
PreformatStart; PreformatStart;
system.Write(Log); system.Write(MyEscapeHTML(Log));
system.flush(output); system.flush(output);
PreformatEnd; PreformatEnd;
end; end;