paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 12:39:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@35954 -
This commit is contained in:
michael 2017-04-26 13:24:42 +00:00
parent 5f66f5cebb
commit 3c53796044
2 changed files with 31 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
packages/fcl-fpcunit/src/consoletestrunner.pas
View File

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

31
packages/fcl-fpcunit/src/fpcunit.pp
View File

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