From 16e50abd749b0e0ba2b14900ed00bf85b2db7317 Mon Sep 17 00:00:00 2001
From: Mattias Gaertner <nc-gaertnma@netcologne.de>
Date: Thu, 20 Aug 2020 17:19:56 +0000
Subject: [PATCH] fcl-passrc: fixed memeleak when error during parsing generic
 constraints

git-svn-id: trunk@46516 -
---
 packages/fcl-passrc/src/pastree.pp | 38 +++++++++++++++++++++++++-----
 packages/fcl-passrc/src/pparser.pp |  7 +++++-
 2 files changed, 38 insertions(+), 7 deletions(-)

diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp
index 1cd85ff610..7abdd74939 100644
--- a/packages/fcl-passrc/src/pastree.pp
+++ b/packages/fcl-passrc/src/pastree.pp
@@ -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
diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 5bd6fbbcda..c8a9fe2d36 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -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;