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

git-svn-id: trunk@35756 -

packages/fcl-fpcunit/src/xmltestreport.pp

@@ -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;