* Hopefully fix bug #29722 (wrong handling of TTestItem list)

git-svn-id: trunk@33206 -

packages/fcl-fpcunit/src/consoletestrunner.pas

@@ -295,8 +295,8 @@ Var
   I : Integer;
 begin
   If (T is TTestSuite) then
-    for I:=0 to TTestSuite(t).Tests.Count-1 do
-      FreeDecorators(TTest(TTestSuite(t).Tests[i]));
+    for I:=0 to TTestSuite(t).ChildTestCount-1 do
+      FreeDecorators(TTest(TTestSuite(t).Test[i]));
   if (T is TTestDecorator) and (TTestDecorator(T).Test is TDecoratorTestSuite) then
     T.free;
 end;
@@ -339,7 +339,7 @@ procedure TTestRunner.DoRun;
         begin
         if (test is ttestsuite) then
           begin
-          for I := 0 to TTestSuite(test).Tests.Count - 1 do
+          for I := 0 to TTestSuite(test).ChildTestCount - 1 do
              CheckTestRegistry ((test as TTestSuite).Test[I], c, res)
           end
         else if (test is TTestDecorator) then
@@ -391,7 +391,7 @@ begin
     S := '';
     S := GetOptionValue('suite');
     if S = '' then
-      for I := 0 to GetTestRegistry.Tests.Count - 1 do
+      for I := 0 to GetTestRegistry.ChildTestCount - 1 do
         writeln(GetTestRegistry[i].TestName)
     else
       begin
@@ -402,13 +402,13 @@ begin
             P:=Pos(',',S);
             if P = 0 Then
               begin
-                for I := 0 to GetTestRegistry.Tests.count-1 do
+                for I := 0 to GetTestRegistry.ChildTestCount-1 do
                   CheckTestRegistry (GetTestregistry[I], S, TS);
                 S := '';
               end
             else
               begin
-                for I := 0 to GetTestRegistry.Tests.count-1 do
+                for I := 0 to GetTestRegistry.ChildTestCount-1 do
                   CheckTestRegistry (GetTestregistry[I],Copy(S, 1,P - 1), TS);
                 Delete(S, 1, P);
               end;

packages/fcl-fpcunit/src/fpcunit.pp

@@ -241,6 +241,7 @@ type
     FTestSuiteName: string;
     FEnableIgnores: boolean;
     function GetTest(Index: integer): TTest;
+    function GetTestCount: Integer;
   protected
     Function DoAddTest(ATest : TTest) : Integer;
     function GetTestName: string; override;
@@ -263,9 +264,11 @@ type
     procedure AddTestSuiteFromClass(ATestClass: TClass); virtual;
     class function Warning(const aMessage: string): TTestCase;
     property Test[Index: integer]: TTest read GetTest; default;
+    Property ChildTestCount : Integer Read GetTestCount;
     property TestSuiteName: string read GetTestSuiteName write SetTestSuiteName;
     property TestName: string read GetTestName write SetTestName;
-    property Tests: TFPList read FTests;
+    // Only for backwards compatibility. Use Test and ChildTestCount.
+    property Tests: TFPList read FTests; deprecated;
   end;
   
   TProtect = procedure(aTest: TTest; aResult: TTestResult);
@@ -1199,6 +1202,11 @@ begin
   Result := TTestItem(FTests[Index]).Test;
 end;
 
+function TTestSuite.GetTestCount: Integer;
+begin
+  Result:=FTests.Count;
+end;
+
 function TTestSuite.DoAddTest(ATest: TTest): Integer;
 begin
   Result:=FTests.Add(TTestItem.Create(ATest));

packages/fcl-fpcunit/src/latextestreport.pp

@@ -257,7 +257,7 @@ var
 begin
   Result := TLatexResultsWriter.EscapeText(aSuite.TestSuiteName) + System.sLineBreak;
   Result := Result + '\begin{itemize}'+ System.sLineBreak;
-  for i := 0 to aSuite.CountTestCases - 1 do
+  for i := 0 to aSuite.ChildTestCount - 1 do
     if ASuite.Test[i] is TTestSuite then
       begin
       Result:=Result + '\item[-] ';

packages/fcl-fpcunit/src/plaintestreport.pp

@@ -214,7 +214,7 @@ var
   p : string;
 begin
   Result := Prefix+ASuite.TestName+System.sLineBreak;
-  for i := 0 to aSuite.CountTestCases - 1 do
+  for i := 0 to aSuite.ChildTestCount - 1 do
     if aSuite.Test[i] is TTestSuite then
       begin
       P:=Prefix;

packages/fcl-fpcunit/src/testregistry.pp

@@ -63,7 +63,7 @@ var
   lSuiteName: String;
   lPathRemainder: String;
   lDotPos: Integer;
-  lTests: TFPList;
+
 begin
   if APath = '' then
   begin
@@ -89,19 +89,15 @@ begin
 
     // Check to see if the path already exists
     lTargetSuite := nil;
-    lTests := ARootSuite.Tests;
-    for i := 0 to lTests.Count -1 do
-    begin
-      lCurrentTest := TTest(lTests[i]);
-      if lCurrentTest is TTestSuite then
+    I:=0;
+    While (lTargetSuite=Nil) and (I<ARootSuite.ChildTestCount) do
       begin
+      lCurrentTest:= ARootSuite.Test[i];
+      if lCurrentTest is TTestSuite then
         if (lCurrentTest.TestName = lSuiteName) then
-        begin
           lTargetSuite := TTestSuite(lCurrentTest);
-          break;
-        end;
+      Inc(I);
       end;  { if }
-    end;  { for }
 
     if not Assigned(lTargetSuite) then
     begin

packages/fcl-fpcunit/src/testreport.pp

@@ -186,33 +186,59 @@ var
 begin
   Result := StringOfChar(' ',Indent) + '<TestSuite name="' + ASuite.TestName + '">' + System.sLineBreak;
   Inc(Indent, 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]),Indent)
+  for i := 0 to aSuite.ChildTestCount - 1 do
+    if TTest(aSuite.Test[i]) is TTestSuite then
+      Result := Result + TestSuiteAsXML(TTestSuite(aSuite.Test[i]),Indent)
     else
-      if TTest(aSuite.Tests.Items[i]) is TTestCase then
-        Result := Result + StringOfChar(' ',Indent) + '<test>' + TTestcase(aSuite.Tests.Items[i]).TestName + '</test>' + System.sLineBreak;
+      if TTest(aSuite.Test[i]) is TTestCase then
+        Result := Result + StringOfChar(' ',Indent) + '<test>' + TTestcase(aSuite.Test[i]).TestName + '</test>' + System.sLineBreak;
   Dec(Indent, 2);
   Result := Result + StringOfChar(' ',Indent) + '</TestSuite>' + System.sLineBreak;
 end;
 
+function EscapeText(const S: string): String;
+var
+  i: integer;
+begin
+  SetLength(Result, 0);
+    for i := 1 to Length(S) do
+      case S[i] of
+        '&','{','}','#','_','$','%':     // Escape these characters
+          Result := Result + '\' + S[i];
+        '~','^':
+          Result := Result + '\'+S[i]+' ';
+        '\':
+          Result := Result + '$\backslash$';
+        '<':
+          Result := Result + '$<$';
+        '>':
+          Result := Result + '$>$'
+        else
+          Result := Result + S[i];
+      end;
+end;
 
 function TestSuiteAsLatex(aSuite:TTestSuite): string;
 var
   i,j: integer;
   s: TTestSuite;
 begin
-  Result := '\flushleft' + System.sLineBreak;
-  for i := 0 to aSuite.Tests.Count - 1 do
-  begin
-    s := TTestSuite(ASuite.Tests.Items[i]);
-    Result := Result + s.TestSuiteName + System.sLineBreak;
-    Result := Result + '\begin{itemize}'+ System.sLineBreak;
-    for j := 0 to s.Tests.Count - 1 do
-      if TTest(s.Tests.Items[j]) is TTestCase then
-        Result := Result + '\item[-] ' + TTestcase(s.Tests.Items[j]).TestName  + System.sLineBreak;
-    Result := Result +'\end{itemize}' + System.sLineBreak;
-  end;
+  Result := EscapeText(aSuite.TestSuiteName) + System.sLineBreak;
+  Result := Result + '\begin{itemize}'+ System.sLineBreak;
+  for i := 0 to aSuite.ChildTestCount - 1 do
+    if ASuite.Test[i] is TTestSuite then
+      begin
+      Result:=Result + '\item[-] ';
+      Result := Result + '\flushleft' + System.sLineBreak;
+      Result:=Result+TestSuiteAsLatex(TTestSuite(ASuite.Test[i]))+System.sLineBreak;
+      end
+    else   
+      begin
+      Result := Result + '\item[-] ' + 
+               EscapeText(TTestcase(aSuite.Test[i]).TestName)
+               + System.sLineBreak;
+      end;    
+  Result := Result +'\end{itemize}' + System.sLineBreak;
 end;
 
 function TestSuiteAsPlain(aSuite:TTestSuite): string;
@@ -220,12 +246,12 @@ var
   i,j: integer;
   s: TTestSuite;
 begin
-  for i := 0 to aSuite.Tests.Count - 1 do
-    if TTest(aSuite.Tests.Items[i]) is TTestSuite then
-      Result := Result + TestSuiteAsPlain(TTestSuite(aSuite.Tests.Items[i]))
+  for i := 0 to aSuite.ChildTestCount - 1 do
+    if TTest(aSuite.Test[i]) is TTestSuite then
+      Result := Result + TestSuiteAsPlain(TTestSuite(aSuite.Test[i]))
     else
-      if TTest(aSuite.Tests.Items[i]) is TTestCase then
-        Result := Result + '  ' + ASuite.TestName+'.' + TTestcase(aSuite.Tests.Items[i]).TestName + System.sLineBreak;
+      if TTest(aSuite.Test[i]) is TTestCase then
+        Result := Result + '  ' + ASuite.TestName+'.' + TTestcase(aSuite.Test[i]).TestName + System.sLineBreak;
 end;
 
 function GetSuiteAsXML(aSuite: TTestSuite): string;

packages/fcl-fpcunit/src/xmltestreport.pp

@@ -112,7 +112,7 @@ begin
     end
   else
     E:=N;
-  for i:=0 to Pred(aSuite.CountTestCases) do
+  for i:=0 to Pred(aSuite.ChildTestCount) do
     if TTest(aSuite.Test[i]) is TTestSuite then
       TestSuiteAsXML(E, FDoc, TTestSuite(aSuite.Test[i]))
     else