paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 21:19:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed memeleak when error during parsing generic constraints

Browse Source 
git-svn-id: trunk@46516 -
This commit is contained in:
Mattias Gaertner 2020-08-20 17:19:56 +00:00
parent 89752e042d
commit 16e50abd74
2 changed files with 38 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
packages/fcl-passrc/src/pastree.pp
View File

@ -562,12 +562,15 @@ type
{ TPasGenericTemplateType - type param of a generic }
TPasGenericTemplateType = Class(TPasType)
protected
procedure SetParent(const AValue: TPasElement); override;
public
destructor Destroy; override;
function GetDeclaration(full : boolean) : string; override;
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
const Arg: Pointer); override;
procedure AddConstraint(El: TPasElement);
procedure ClearConstraints;
Public
TypeConstraint: String deprecated; // deprecated in fpc 3.3.1
Constraints: TPasElementArray; // list of TPasExpr or TPasType, can be nil!
@ -1962,13 +1965,20 @@ end;
{ TPasGenericTemplateType }
destructor TPasGenericTemplateType.Destroy;
var
i: Integer;
procedure TPasGenericTemplateType.SetParent(const AValue: TPasElement);
begin
for i:=0 to length(Constraints)-1 do
Constraints[i].Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
Constraints:=nil;
if (AValue=nil) and (Parent<>nil) then
begin
// parent is cleared
// -> clear all references to this class (releasing loops)
ClearConstraints;
end;
inherited SetParent(AValue);
end;
destructor TPasGenericTemplateType.Destroy;
begin
ClearConstraints;
inherited Destroy;
end;
@ -2008,6 +2018,22 @@ begin
Constraints[l]:=El;
end;
procedure TPasGenericTemplateType.ClearConstraints;
var
i: Integer;
aConstraint: TPasElement;
begin
// -> clear all references to this class (releasing loops)
for i:=0 to length(Constraints)-1 do
begin
aConstraint:=Constraints[i];
if aConstraint.Parent=Self then
aConstraint.Parent:=nil;
aConstraint.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
end;
Constraints:=nil;
end;
{$IFDEF HasPTDumpStack}
procedure PTDumpStack;
begin

7
packages/fcl-passrc/src/pparser.pp
View File

@ -4429,6 +4429,7 @@ var
i: Integer;
AObjKind: TPasObjKind;
ok: Boolean;
GenTempl: TPasGenericTemplateType;
begin
Result:=nil;
ok := false;
@ -4517,7 +4518,11 @@ begin
if (not ok) and (Result<>nil) and not AddToParent then
Result.Release({$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF});
for i:=0 to TypeParams.Count-1 do
TPasElement(TypeParams[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
begin
GenTempl:=TPasGenericTemplateType(TypeParams[i]);
GenTempl.Parent:=nil;
GenTempl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
end;
TypeParams.Free;
end;
end;