Merged revisions 7493 via svnmerge from

svn+ssh://joost@svn.freepascal.org/FPC/svn/fpc/trunk

........
r7493 | florian | 2007-05-28 11:58:11 +0200 (Mon, 28 May 2007) | 1 line

+ from Darius Blaszijk: GetSuiteAsXML and TestSuiteAsXML implementation
........


git-svn-id: http://svn.freepascal.org/svn/fpc/branches/fixes_2_2@8034 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 40 insertions, 0 deletions

diff --git a/packages/fcl-fpcunit/src/xmltestreport.pp b/packages/fcl-fpcunit/src/xmltestreport.pp
index 52c0272234..d2b8a37943 100644
--- a/packages/fcl-fpcunit/src/xmltestreport.pp
+++ b/packages/fcl-fpcunit/src/xmltestreport.pp
@@ -65,9 +65,47 @@ type
     property Document: TXMLDocument read FDoc;
   end;
 
+function GetSuiteAsXML(aSuite: TTestSuite): string;
+function TestSuiteAsXML(n: TDOMElement; FDoc: TXMLDocument; aSuite:TTestSuite): string;
 
 implementation
 
+function GetSuiteAsXML(aSuite: TTestSuite): string;
+var
+  FDoc: TXMLDocument;
+  n: TDOMElement;
+  stream : TStringStream;
+begin
+  Result := '';
+
+  if aSuite <> nil then
+  begin
+    FDoc:= TXMLDocument.Create;
+
+    n := FDoc.CreateElement('TestSuites');
+    FDoc.AppendChild(n);
+
+    TestSuiteAsXML(n, FDoc, aSuite);
+
+    stream := TStringStream.Create('');
+    WriteXMLFile(FDoc, stream);
+    writeln(stream.DataString);
+    stream.Free;
+  end;
+end;
+
+function TestSuiteAsXML(n: TDOMElement; FDoc: TXMLDocument; aSuite:TTestSuite): string;
+var
+  i: integer;
+begin
+  for i := 0 to Pred(aSuite.Tests.Count) do
+    if TTest(aSuite.Tests.Items[i]) is TTestSuite then
+      TestSuiteAsXML(n, FDoc, TTestSuite(aSuite.Tests.Items[i]))
+    else
+      if TTest(aSuite.Tests.Items[i]) is TTestCase then
+        n.AppendChild(FDoc.CreateTextNode(TTestcase(aSuite.Tests.Items[i]).TestName + ' '));
+end;
+
 
 { TXMLResultsWriter }
 
@@ -246,3 +284,5 @@ end;
 
 end.
 
+
+