Bläddra i källkod

* Add some methods for improved DUnit compatibility

Michaël Van Canneyt 2 år sedan
förälder
incheckning
92eab370c3

+ 6 - 0
packages/fcl-fpcunit/src/fpcunit.pp

@@ -229,6 +229,7 @@ type
     function CreateResultAndRun: TTestResult; virtual;
     procedure Run(AResult: TTestResult); override;
     function AsString: string;
+    class function AsSuite : TTestSuite;
     property TestSuiteName: string read GetTestSuiteName write SetTestSuiteName;
     Property ExpectedExceptionFailMessage  : String Read FExpectedExceptionFailMessage;
     Property ExpectedException : TClass Read FExpectedException;
@@ -1012,6 +1013,11 @@ begin
   Result := TestName + '(' + ClassName + ')';
 end;
 
+class function TTestCase.AsSuite: TTestSuite;
+begin
+  Result:=TTestSuite.Create(Self.ClassType);
+end;
+
 
 function TTestCase.CountTestCases: integer;
 begin

+ 14 - 0
packages/fcl-fpcunit/src/testregistry.pp

@@ -34,6 +34,10 @@ procedure RegisterTest(const ASuitePath: String; ATest: TTest); overload;
 procedure RegisterTests(ATests: Array of TTestCaseClass);
 procedure RegisterTests(const ASuitePath: String; ATests: Array of TTestCaseClass);
 
+procedure RegisterTest(aSuite: TTestSuite);
+procedure RegisterTest(const aSuitePath : String; aSuite: TTestSuite);
+
+
 procedure RegisterTestDecorator(ADecoratorClass: TTestDecoratorClass; ATestClass: TTestCaseClass);
 
 function NumberOfRegisteredTests: longint;
@@ -151,6 +155,16 @@ begin
     end;
 end;
 
+procedure RegisterTest(aSuite: TTestSuite);
+begin
+  GetTestRegistry.AddTest(aSuite);
+end;
+
+procedure RegisterTest(const aSuitePath: String; aSuite: TTestSuite);
+begin
+  RegisterTestInSuite(GetTestRegistry, aSuitePath, aSuite);
+end;
+
 
 function NumberOfRegisteredTests: longint;
 begin

+ 4 - 4
packages/fcl-fpcunit/src/tests/asserttest.pp

@@ -403,12 +403,12 @@ begin
   ts := TTestSuite.Create(TTestIgnore);
   try
     AssertTrue('EnableIgnores must be True at creation', ts.EnableIgnores);
-    for i := 0 to ts.Tests.Count - 1 do
-      AssertTrue('EnableIgnores of Test ' + IntToStr(i) + ' must be True at creation', TTest(ts.Tests[i]).EnableIgnores);
+    for i := 0 to ts.ChildTestCount - 1 do
+      AssertTrue('EnableIgnores of Test ' + IntToStr(i) + ' must be True at creation', ts.Test[i].EnableIgnores);
     ts.EnableIgnores := False; 
     AssertFalse('EnableIgnores was not set to false', ts.EnableIgnores);
-    for i := 0 to ts.Tests.Count - 1 do
-      AssertFalse('EnableIgnores of Test ' + IntToStr(i) + ' was not set to False', TTest(ts.Tests[i]).EnableIgnores);
+    for i := 0 to ts.ChildTestCount - 1 do
+      AssertFalse('EnableIgnores of Test ' + IntToStr(i) + ' was not set to False', ts.Test[i].EnableIgnores);
   finally
     ts.Free;
   end;

+ 17 - 0
packages/fcl-fpcunit/src/tests/suitetest.pp

@@ -53,6 +53,8 @@ type
     procedure Test2;
   end;
 
+  { TSuiteTest }
+
   TSuiteTest = class(TTestCase)
   private
     FResult: TTestResult;
@@ -70,6 +72,7 @@ type
     procedure testShadowedTests;
     procedure testAddTestSuiteFromClass;
     procedure testCreateTestSuiteFromArray;
+    procedure testTestCaseAsSuite;
   end;
 
 
@@ -217,6 +220,20 @@ begin
   end;
 end;
 
+procedure TSuiteTest.testTestCaseAsSuite;
+var
+  ts: TTestSuite;
+begin
+  ts := TOneTestCase.AsSuite;
+  try
+    AssertEquals(1, ts.CountTestCases);
+    AssertEquals(1, ts.Tests.Count);
+    AssertEquals('OnlyOneTestCase', ts[0].TestName);
+  finally
+    ts.Free;
+  end;
+end;
+
 initialization
 
   RegisterTests([TSuiteTest]);