paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-06 22:27:53 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Resolved infinitive loop on an exception during the one-time-setup of a testsuite

Browse Source 
git-svn-id: trunk@35756 -
This commit is contained in:
joost 2017-04-08 14:43:21 +00:00
parent 1888f8747f
commit 11b163ee18
1 changed files with 31 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
packages/fcl-fpcunit/src/xmltestreport.pp
View File

@ -49,6 +49,7 @@ type
FSuitePath: TFPList;
FCurrentTest: TDOMElement;
protected
function GetCurrentElement: TDOMElement;
procedure WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer); override;
procedure WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime); override;
procedure WriteSuiteHeader(ATestSuite: TTestSuite; ALevel: integer); override;
@ -129,6 +130,18 @@ end;
{ TXMLResultsWriter }
function TXMLResultsWriter.GetCurrentElement: TDOMElement;
begin
if Assigned(FCurrentTest) then
Result := FCurrentTest
else if FSuitePath.Count > 0 then
//test is included in a suite
Result := TDOMElement(FSuitePath[FSuitePath.Count -1])
else
//no suite to append so append directly to the listing node
FListing.LastChild;
end;
procedure TXMLResultsWriter.WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer);
var
n: TDOMElement;
@ -223,35 +236,41 @@ begin
end;
procedure TXMLResultsWriter.AddFailure(ATest: TTest; AFailure: TTestFailure);
var
CurrentElement: TDOMElement;
begin
inherited;
CurrentElement := GetCurrentElement;
if AFailure.IsIgnoredTest then
FCurrentTest['Result'] := 'Ignored'
CurrentElement['Result'] := 'Ignored'
else
FCurrentTest['Result'] := 'Failed';
FCurrentTest.AppendChild(FDoc.CreateElement('Message')).AppendChild
CurrentElement['Result'] := 'Failed';
CurrentElement.AppendChild(FDoc.CreateElement('Message')).AppendChild
(FDoc.CreateTextNode(AFailure.AsString));
FCurrentTest.AppendChild(FDoc.CreateElement('ExceptionClass')).AppendChild
CurrentElement.AppendChild(FDoc.CreateElement('ExceptionClass')).AppendChild
(FDoc.CreateTextNode(AFailure.ExceptionClassName));
FCurrentTest.AppendChild(FDoc.CreateElement('ExceptionMessage')).AppendChild
CurrentElement.AppendChild(FDoc.CreateElement('ExceptionMessage')).AppendChild
(FDoc.CreateTextNode(AFailure.ExceptionMessage));
end;
procedure TXMLResultsWriter.AddError(ATest: TTest; AError: TTestFailure);
var
CurrentElement: TDOMElement;
begin
inherited;
FCurrentTest['Result'] := 'Error';
FCurrentTest.AppendChild(FDoc.CreateElement('Message')).AppendChild
CurrentElement := GetCurrentElement;
CurrentElement['Result'] := 'Error';
CurrentElement.AppendChild(FDoc.CreateElement('Message')).AppendChild
(FDoc.CreateTextNode(AError.AsString));
FCurrentTest.AppendChild(FDoc.CreateElement('ExceptionClass')).AppendChild
CurrentElement.AppendChild(FDoc.CreateElement('ExceptionClass')).AppendChild
(FDoc.CreateTextNode(AError.ExceptionClassName));
FCurrentTest.AppendChild(FDoc.CreateElement('ExceptionMessage')).AppendChild
CurrentElement.AppendChild(FDoc.CreateElement('ExceptionMessage')).AppendChild
(FDoc.CreateTextNode(AError.ExceptionMessage));
FCurrentTest.AppendChild(FDoc.CreateElement('SourceUnitName')).AppendChild
CurrentElement.AppendChild(FDoc.CreateElement('SourceUnitName')).AppendChild
(FDoc.CreateTextNode(AError.SourceUnitName));
FCurrentTest.AppendChild(FDoc.CreateElement('LineNumber')).AppendChild
CurrentElement.AppendChild(FDoc.CreateElement('LineNumber')).AppendChild
(FDoc.CreateTextNode(IntToStr(AError.LineNumber)));
FCurrentTest.AppendChild(FDoc.CreateElement('FailedMethodName')).AppendChild
CurrentElement.AppendChild(FDoc.CreateElement('FailedMethodName')).AppendChild
(FDoc.CreateTextNode(AError.FailedMethodName));
end;