Browse Source

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

git-svn-id: trunk@46516 -
Mattias Gaertner 5 years ago
parent
commit
16e50abd74
2 changed files with 37 additions and 6 deletions
  1. 31 5
      packages/fcl-passrc/src/pastree.pp
  2. 6 1
      packages/fcl-passrc/src/pparser.pp

+ 31 - 5
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 }
 
+procedure TPasGenericTemplateType.SetParent(const AValue: TPasElement);
+begin
+  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;
-var
-  i: Integer;
 begin
-  for i:=0 to length(Constraints)-1 do
-    Constraints[i].Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
-  Constraints:=nil;
+  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

+ 6 - 1
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;