paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 13:49:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Patch from Graeme Geldenhuys: Correct indentation of XML

Browse Source 
git-svn-id: trunk@5024 -
This commit is contained in:
michael 2006-10-26 11:44:44 +00:00
parent cb1f52626e
commit afbd50967c
1 changed files with 28 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
fcl/fpcunit/testreport.pp
View File

@ -64,6 +64,23 @@ function TestResultAsPlain(aTestResult: TTestResult): string;
implementation
var
uLevel: integer; // indentation counter
// Helper function: Return a string of spaces pIntLen long
function trSpace(pIntLen: integer): string;
var
i: integer;
sString: string;
begin
sString := '';
for i := 1 to pIntLen do
sString := sString + ' ';
Result := sString;
end;
{TXMLResultsWriter}
procedure TXMLResultsWriter.WriteHeader;
begin
@ -131,7 +148,7 @@ end;
procedure TPlainResultsWriter.StartTest(ATest: TTest);
begin
writeln('Test: ' , ATest.TestSuiteName + '.' + ATest.TestName);
write('Test: ' , ATest.TestSuiteName + '.' + ATest.TestName);
end;
procedure TPlainResultsWriter.EndTest(ATest: TTest);
@ -144,16 +161,19 @@ function TestSuiteAsXML(aSuite:TTestSuite): string;
var
i: integer;
begin
Result := '<TestSuite name="' + ASuite.TestName + '">' + System.sLineBreak;
Result := trSpace(uLevel) + '<TestSuite name="' + ASuite.TestName + '">' + System.sLineBreak;
Inc(uLevel, 2);
for i := 0 to aSuite.Tests.Count - 1 do
if TTest(aSuite.Tests.Items[i]) is TTestSuite then
Result := Result + TestSuiteAsXML(TTestSuite(aSuite.Tests.Items[i]))
else
if TTest(aSuite.Tests.Items[i]) is TTestCase then
Result := Result +'<test>' + TTestcase(aSuite.Tests.Items[i]).TestName + '</test>' + System.sLineBreak;
Result := Result + '</TestSuite>' + System.sLineBreak;
Result := Result + trSpace(uLevel) + '<test>' + TTestcase(aSuite.Tests.Items[i]).TestName + '</test>' + System.sLineBreak;
Dec(uLevel, 2);
Result := Result + trSpace(uLevel) + '</TestSuite>' + System.sLineBreak;
end;
function TestSuiteAsLatex(aSuite:TTestSuite): string;
var
i,j: integer;
@ -315,4 +335,8 @@ begin
Result := Result + System.sLineBreak;
end;
initialization
uLevel := 0;
end.