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

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

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