浏览代码

* Fix memleak in case only a selection of tests is run

git-svn-id: trunk@35954 -
michael 8 年之前
父节点
当前提交
3c53796044
共有 2 个文件被更改,包括 30 次插入16 次删除
  1. 2 15
      packages/fcl-fpcunit/src/consoletestrunner.pas
  2. 28 1
      packages/fcl-fpcunit/src/fpcunit.pp

+ 2 - 15
packages/fcl-fpcunit/src/consoletestrunner.pas

@@ -285,29 +285,16 @@ Type
 
   TDecoratorTestSuite = Class(TTestSuite)
   public
-    Procedure  FreeDecorators(T : TTest);
     Destructor Destroy; override;
   end;
 
-Procedure  TDecoratorTestSuite.FreeDecorators(T : TTest);
-
-Var
-  I : Integer;
-begin
-  If (T is TTestSuite) then
-    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;
 
 { TDecoratorTestSuite }
 
 destructor TDecoratorTestSuite.Destroy;
+
 begin
-  FreeDecorators(Self);
-  // We need to find something for this.
-  Tests.Clear;
+  OwnsTests:=False;
   inherited Destroy;
 end;
 

+ 28 - 1
packages/fcl-fpcunit/src/fpcunit.pp

@@ -244,11 +244,14 @@ type
 
   TTestSuite = class(TTest)
   private
+    FOwnsTests: Boolean;
     FTests: TFPList;
     FName: string;
     FTestSuiteName: string;
     FEnableIgnores: boolean;
+    procedure SetOwnsTests(AValue: Boolean);
   protected
+    Procedure SetOwnTestOnTests(AValue: Boolean);
     Function DoAddTest(ATest : TTest) : Integer;
     function GetTestName: string; override;
     function GetTestSuiteName: string; override;
@@ -256,6 +259,7 @@ type
     procedure SetTestSuiteName(const aName: string); override;
     procedure SetTestName(const Value: string); virtual;
     procedure SetEnableIgnores(Value: boolean); override;
+    property OwnsTests : Boolean Read FOwnsTests Write SetOwnsTests;
   public
     constructor Create(AClass: TClass; AName: string); reintroduce; overload; virtual;
     constructor Create(AClass: TClass); reintroduce; overload; virtual;
@@ -1252,6 +1256,7 @@ constructor TTestSuite.Create;
 begin
   inherited Create;
   FTests := TFPList.Create;
+  FOwnsTests:=True;
   FEnableIgnores := True;
 end;
 
@@ -1274,9 +1279,31 @@ begin
   Result:=FTests.Count;
 end;
 
+procedure TTestSuite.SetOwnsTests(AValue: Boolean);
+begin
+  if FOwnsTests=AValue then Exit;
+  FOwnsTests:=AValue;
+  SetOwnTestOnTests(AValue);
+end;
+
+procedure TTestSuite.SetOwnTestOnTests(AValue: Boolean);
+Var
+  I : Integer;
+
+begin
+  For I:=0 to FTests.Count-1 do
+    TTestItem(FTests[i]).OwnsTest:=AValue;
+end;
+
 function TTestSuite.DoAddTest(ATest: TTest): Integer;
+
+Var
+  I : TTestItem;
+
 begin
-  Result:=FTests.Add(TTestItem.Create(ATest));
+  I:=TTestItem.Create(ATest);
+  I.OwnsTest:=OwnsTests;
+  Result:=FTests.Add(I);
   if ATest.TestSuiteName = '' then
     ATest.TestSuiteName := Self.TestName;
   ATest.EnableIgnores := Self.EnableIgnores;