paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 16:59:12 +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 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} {TXMLResultsWriter}
procedure TXMLResultsWriter.WriteHeader; procedure TXMLResultsWriter.WriteHeader;
begin begin
@ -131,7 +148,7 @@ end;
procedure TPlainResultsWriter.StartTest(ATest: TTest); procedure TPlainResultsWriter.StartTest(ATest: TTest);
begin begin
writeln('Test: ' , ATest.TestSuiteName + '.' + ATest.TestName); write('Test: ' , ATest.TestSuiteName + '.' + ATest.TestName);
end; end;
procedure TPlainResultsWriter.EndTest(ATest: TTest); procedure TPlainResultsWriter.EndTest(ATest: TTest);
@ -144,16 +161,19 @@ function TestSuiteAsXML(aSuite:TTestSuite): string;
var var
i: integer; i: integer;
begin 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 for i := 0 to aSuite.Tests.Count - 1 do
if TTest(aSuite.Tests.Items[i]) is TTestSuite then if TTest(aSuite.Tests.Items[i]) is TTestSuite then
Result := Result + TestSuiteAsXML(TTestSuite(aSuite.Tests.Items[i])) Result := Result + TestSuiteAsXML(TTestSuite(aSuite.Tests.Items[i]))
else else
if TTest(aSuite.Tests.Items[i]) is TTestCase then if TTest(aSuite.Tests.Items[i]) is TTestCase then
Result := Result +'<test>' + TTestcase(aSuite.Tests.Items[i]).TestName + '</test>' + System.sLineBreak; Result := Result + trSpace(uLevel) + '<test>' + TTestcase(aSuite.Tests.Items[i]).TestName + '</test>' + System.sLineBreak;
Result := Result + '</TestSuite>' + System.sLineBreak; Dec(uLevel, 2);
Result := Result + trSpace(uLevel) + '</TestSuite>' + System.sLineBreak;
end; end;
function TestSuiteAsLatex(aSuite:TTestSuite): string; function TestSuiteAsLatex(aSuite:TTestSuite): string;
var var
i,j: integer; i,j: integer;
@ -315,4 +335,8 @@ begin
Result := Result + System.sLineBreak; Result := Result + System.sLineBreak;
end; end;
initialization
uLevel := 0;
end. end.