[fpc-devel] [patch] - fpcUnit testreport.pp

[Graeme Geldenhuys]

Hi,

Attached is a patch for testreport.pp (part of fpcUnit) that corrects
indentation of XML output listing all available test casses.

Patch needs to be applied from the root FPC 2.1.1 directory.

Regards,
 - Graeme -


--
There's no place like 127.0.0.1

Index: fcl/fpcunit/testreport.pp
===================================================================
--- fcl/fpcunit/testreport.pp	(revision 5023)
+++ fcl/fpcunit/testreport.pp	(working copy)
@@ -64,6 +64,23 @@
 
 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 @@
 
 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 @@
 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 @@
   Result := Result + System.sLineBreak;
 end;
 
+
+initialization
+  uLevel := 0;
+  
 end.

_______________________________________________
fpc-devel maillist  -  fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel