paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 12:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ from Darius Blaszijk: GetSuiteAsXML and TestSuiteAsXML implementation

Browse Source 
git-svn-id: trunk@7493 -
This commit is contained in:
florian 2007-05-28 09:58:11 +00:00
parent 4782e744e8
commit b261bdf52f
1 changed files with 40 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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 }
@ -251,3 +289,5 @@ end;
end.