Browse Source

* Modified patch from Brainenjii to support multiple testsuites (bug 21655)

git-svn-id: trunk@20720 -
michael 13 years ago
parent
commit
84f0d3d99a
1 changed files with 38 additions and 8 deletions
  1. 38 8
      packages/fcl-fpcunit/src/consoletestrunner.pas

+ 38 - 8
packages/fcl-fpcunit/src/consoletestrunner.pas

@@ -270,7 +270,7 @@ end;
 
 
 procedure TTestRunner.DoRun;
 procedure TTestRunner.DoRun;
 
 
-  procedure CheckTestRegistry (test:TTest; ATestName:string);
+  procedure CheckTestRegistry (test:TTest; ATestName:string; res : TTestSuite);
   var s, c : string;
   var s, c : string;
       I, p : integer;
       I, p : integer;
   begin
   begin
@@ -288,21 +288,23 @@ procedure TTestRunner.DoRun;
         c := ATestName;
         c := ATestName;
         end;
         end;
       if comparetext(c, test.TestName) = 0 then
       if comparetext(c, test.TestName) = 0 then
-        DoTestRun(test)
+        res.AddTest(test)
       else if (CompareText( s, Test.TestName) = 0) or (s = '') then
       else if (CompareText( s, Test.TestName) = 0) or (s = '') then
         for I := 0 to TTestSuite(test).Tests.Count - 1 do
         for I := 0 to TTestSuite(test).Tests.Count - 1 do
-          CheckTestRegistry (TTest(TTestSuite(test).Tests[I]), c)
+          CheckTestRegistry (TTest(TTestSuite(test).Tests[I]), c, res)
       end
       end
     else // if test is TTestCase then
     else // if test is TTestCase then
       begin
       begin
       if comparetext(test.TestName, ATestName) = 0 then
       if comparetext(test.TestName, ATestName) = 0 then
-        DoTestRun(test);
+        res.AddTest(test);
       end;
       end;
   end;
   end;
 
 
 var
 var
-  I: integer;
-  S: string;
+  I,P : integer;
+  S : string;
+  TS : TTestSuite;
+  
 begin
 begin
   S := CheckOptions(GetShortOpts, LongOpts);
   S := CheckOptions(GetShortOpts, LongOpts);
   if (S <> '') then
   if (S <> '') then
@@ -328,8 +330,36 @@ begin
       for I := 0 to GetTestRegistry.Tests.Count - 1 do
       for I := 0 to GetTestRegistry.Tests.Count - 1 do
         writeln(GetTestRegistry[i].TestName)
         writeln(GetTestRegistry[i].TestName)
     else
     else
-      for I := 0 to GetTestRegistry.Tests.count-1 do
-        CheckTestRegistry (GetTestregistry[I], S);
+      begin
+        TS:=TTestSuite.Create('SuiteList');
+        try
+        while Not(S = '') Do
+          begin
+            P:=Pos(',',S);
+            if P = 0 Then
+              begin
+                for I := 0 to GetTestRegistry.Tests.count-1 do
+                  CheckTestRegistry (GetTestregistry[I], S, TS);
+                S := '';
+              end
+            else
+              begin
+                for I := 0 to GetTestRegistry.Tests.count-1 do
+                  CheckTestRegistry (GetTestregistry[I],Copy(S, 1,P - 1), TS);
+                Delete(S, 1, P);
+              end;
+          end;
+          if (TS.CountTestCases>1) then
+            DoTestRun(TS)
+          else if TS.CountTestCases=1 then
+            DoTestRun(TS[0])
+          else
+            Writeln('No tests selected.');  
+        finally
+          TS.Tests.Clear;
+          TS.Free;
+        end;
+      end;
   end
   end
   else if HasOption('a', 'all') or (DefaultRunAllTests and Not HasOption('l','list')) then
   else if HasOption('a', 'all') or (DefaultRunAllTests and Not HasOption('l','list')) then
     DoTestRun(GetTestRegistry) ;
     DoTestRun(GetTestRegistry) ;