fcl-passrc: fixed mem leaks

git-svn-id: trunk@39414 -

packages/fcl-passrc/src/pasresolver.pp

@@ -212,6 +212,7 @@ Works:
 - $warn identifier ON|off|error|default
 
 ToDo:
+- error if property method resolution is not used
 - $H-hintpos$H+
 - $pop, $push
 - $RTTI inherited|explicit
@@ -2884,7 +2885,11 @@ begin
       end;
     FreeAndNil(Interfaces);
     end;
-  ReleaseAndNil(TPasElement(CanonicalClassOf));
+  if CanonicalClassOf<>nil then
+    begin
+    CanonicalClassOf.Parent:=nil;
+    ReleaseAndNil(TPasElement(CanonicalClassOf));
+    end;
   inherited Destroy;
 end;
 
@@ -3256,6 +3261,8 @@ begin
   AssertClass:=nil;
   AssertDefConstructor:=nil;
   AssertMsgConstructor:=nil;
+  RangeErrorClass:=nil;
+  RangeErrorConstructor:=nil;
   FreeAndNil(PendingResolvers);
   inherited Destroy;
 end;
@@ -4582,7 +4589,8 @@ procedure TPasResolver.FinishTypeSection(El: TPasDeclarations);
     OldDestType:=DestType;
     DestType:=TPasType(Data.Found);
     DestType.AddRef;
-    OldDestType.Release;
+    OldDestType.Release; // once for the create in TPasResolver
+    OldDestType.Release; // and once for the reference in TPasParser
     // check cycles
     if Decl is TPasPointerType then
       CheckPointerCycle(TPasPointerType(Decl));
@@ -4826,7 +4834,7 @@ type
     InterfaceName: string;
     ImplementName: string;
     ResolutionEl: TPasMethodResolution;
-    Count: integer;
+    Count: integer; // needed to check if method resolution is used
   end;
 var
   ClassScope: TPasClassScope;
@@ -4971,6 +4979,8 @@ begin
           Map:=Map.AncestorMap;
           end;
         end;
+
+      // ToDo: hint if method resolution is not used
       end;
     end;
 
@@ -5552,6 +5562,7 @@ procedure TPasResolver.FinishVariable(El: TPasVariable);
 var
   ResolvedAbs: TPasResolverResult;
   C: TClass;
+  Value: TResEvalValue;
 begin
   if (El.Visibility=visPublished) then
     begin
@@ -5566,7 +5577,10 @@ begin
       CheckAssignCompatibility(El,El.Expr,true);
     end
   else if El.Expr<>nil then
-    Eval(El.Expr,[refConst]);
+    begin
+    Value:=Eval(El.Expr,[refConst]);
+    ReleaseEvalValue(Value);
+    end;
   if El.AbsoluteExpr<>nil then
     begin
     if El.ClassType=TPasConst then
@@ -7379,6 +7393,7 @@ var
   LeftResolved, RightResolved: TPasResolverResult;
   Flags: TPasResolverComputeFlags;
   Access: TResolvedRefAccess;
+  Value: TResEvalValue;
 begin
   if El.Kind=akDefault then
     Access:=rraAssign
@@ -7472,7 +7487,8 @@ begin
     else
       RaiseIncompatibleTypeRes(20180208115707,nOperatorIsNotOverloadedAOpB,[AssignKindNames[El.Kind]],LeftResolved,RightResolved,El);
     // store const expression result
-    Eval(El.right,[]);
+    Value:=Eval(El.right,[]);
+    ReleaseEvalValue(Value);
     end;
   else
     RaiseNotYetImplemented(20160927143649,El,'AssignKind '+AssignKindNames[El.Kind]);

packages/fcl-passrc/src/pastree.pp

@@ -133,6 +133,7 @@ type
     FHintMessage : String;
   protected
     procedure ProcessHints(const ASemiColonPrefix: boolean; var AResult: string); virtual;
+    procedure SetParent(const AValue: TPasElement); virtual;
   public
     SourceFilename: string;
     SourceLinenumber: Integer;
@@ -156,10 +157,11 @@ type
     Function HintsString : String;
     function GetDeclaration(full : Boolean) : string; virtual;
     procedure Accept(Visitor: TPassTreeVisitor); override;
+    procedure ClearTypeReferences(aType: TPasElement); virtual;
     function HasParent(aParent: TPasElement): boolean;
     property RefCount: LongWord read FRefCount;
     property Name: string read FName write FName;
-    property Parent: TPasElement read FParent Write FParent;
+    property Parent: TPasElement read FParent Write SetParent;
     Property Hints : TPasMemberHints Read FHints Write FHints;
     Property HintMessage : String Read FHintMessage Write FHintMessage;
     Property DocComment : String Read FDocComment Write FDocComment;
@@ -478,12 +480,15 @@ type
   { TPasAliasType }
 
   TPasAliasType = class(TPasType)
+  protected
+    procedure SetParent(const AValue: TPasElement); override;
   public
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : Boolean): string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
+    procedure ClearTypeReferences(aType: TPasElement); override;
   public
     DestType: TPasType;
     Expr: TPasExpr;
@@ -492,12 +497,15 @@ type
   { TPasPointerType - todo: change it TPasAliasType }
 
   TPasPointerType = class(TPasType)
+  protected
+    procedure SetParent(const AValue: TPasElement); override;
   public
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : Boolean): string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
+    procedure ClearTypeReferences(aType: TPasElement); override;
   public
     DestType: TPasType;
   end;
@@ -539,6 +547,7 @@ type
     function GetDeclaration(full : Boolean): string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
+    procedure ClearTypeReferences(aType: TPasElement); override;
   public
     DestType: TPasType;
   end;
@@ -657,7 +666,10 @@ type
 
   TPasRecordType = class(TPasType)
   private
+    procedure ClearChildReferences(El: TPasElement; arg: pointer);
     procedure GetMembers(S: TStrings);
+  protected
+    procedure SetParent(const AValue: TPasElement); override;
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
@@ -693,6 +705,10 @@ type
   { TPasClassType }
 
   TPasClassType = class(TPasType)
+  private
+    procedure ClearChildReferences(El: TPasElement; arg: pointer);
+  protected
+    procedure SetParent(const AValue: TPasElement); override;
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
@@ -739,6 +755,7 @@ type
     function GetDeclaration(full : boolean) : string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
+    procedure ClearTypeReferences(aType: TPasElement); override;
   public
     Access: TArgumentAccess;
     ArgType: TPasType; // can be nil, when Access<>argDefault
@@ -784,6 +801,7 @@ type
     function ElementTypeName : string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
+    procedure ClearTypeReferences(aType: TPasElement); override;
   public
     ResultType: TPasType;
   end;
@@ -849,6 +867,7 @@ type
     function GetDeclaration(full : boolean) : string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
+    procedure ClearTypeReferences(aType: TPasElement); override;
   public
     VarType: TPasType;
     VarModifiers : TVariableModifiers;
@@ -1460,6 +1479,7 @@ Type
     procedure AddElement(Element: TPasImplElement); override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
+    procedure ClearTypeReferences(aType: TPasElement); override;
   public
     VarEl: TPasVariable; // can be nil
     TypeEl : TPasType;
@@ -1662,6 +1682,12 @@ begin
   DestType.ForEachChildCall(aMethodCall,Arg,DestType,true);
 end;
 
+procedure TInlineTypeExpr.ClearTypeReferences(aType: TPasElement);
+begin
+  if DestType=aType then
+    ReleaseAndNil(TPasElement(DestType));
+end;
+
 { TPasSpecializeType }
 
 constructor TPasSpecializeType.Create(const AName: string; AParent: TPasElement
@@ -2074,6 +2100,12 @@ begin
   ForEachChildCall(aMethodCall,Arg,ResultType,true);
 end;
 
+procedure TPasResultElement.ClearTypeReferences(aType: TPasElement);
+begin
+  if ResultType=aType then
+    ReleaseAndNil(TPasElement(ResultType));
+end;
+
 function TPasFunctionType.ElementTypeName: string; begin Result := SPasTreeFunctionType end;
 function TPasUnresolvedTypeRef.ElementTypeName: string; begin Result := SPasTreeUnresolvedTypeRef end;
 function TPasVariable.ElementTypeName: string; begin Result := SPasTreeVariable end;
@@ -2208,6 +2240,11 @@ begin
     end;
 end;
 
+procedure TPasElement.SetParent(const AValue: TPasElement);
+begin
+  FParent:=AValue;
+end;
+
 constructor TPasElement.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create;
@@ -2372,6 +2409,11 @@ begin
   Visitor.Visit(Self);
 end;
 
+procedure TPasElement.ClearTypeReferences(aType: TPasElement);
+begin
+  if aType=nil then ;
+end;
+
 function TPasElement.HasParent(aParent: TPasElement): boolean;
 var
   El: TPasElement;
@@ -2402,6 +2444,7 @@ end;
 destructor TPasDeclarations.Destroy;
 var
   i: Integer;
+  Child: TPasElement;
 begin
   {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy START');{$ENDIF}
   FreeAndNil(ExportSymbols);
@@ -2414,7 +2457,11 @@ begin
   FreeAndNil(ResStrings);
   {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy Declarations');{$ENDIF}
   for i := 0 to Declarations.Count - 1 do
-    TPasElement(Declarations[i]).Release;
+    begin
+    Child:=TPasElement(Declarations[i]);
+    Child.Parent:=nil;
+    Child.Release;
+    end;
   FreeAndNil(Declarations);
 
   {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy inherited');{$ENDIF}
@@ -2459,6 +2506,18 @@ begin
   inherited Destroy;
 end;
 
+procedure TPasPointerType.SetParent(const AValue: TPasElement);
+begin
+  if (AValue=nil) and (Parent<>nil) and (DestType<>nil)
+      and (DestType.Parent=Parent) then
+    begin
+    // DestType in same type section can create a loop
+    // -> break loop when type section is closed
+    DestType.Release;
+    DestType:=nil;
+    end;
+  inherited SetParent(AValue);
+end;
 
 destructor TPasPointerType.Destroy;
 begin
@@ -2467,6 +2526,18 @@ begin
   inherited Destroy;
 end;
 
+procedure TPasAliasType.SetParent(const AValue: TPasElement);
+begin
+  if (AValue=nil) and (Parent<>nil) and (DestType<>nil)
+      and (DestType.Parent=Parent) then
+    begin
+    // DestType in same type section can create a loop
+    // -> break loop when type section is closed
+    DestType.Release;
+    DestType:=nil;
+    end;
+  inherited SetParent(AValue);
+end;
 
 destructor TPasAliasType.Destroy;
 begin
@@ -2628,6 +2699,23 @@ end;
 
 { TPasClassType }
 
+procedure TPasClassType.ClearChildReferences(El: TPasElement; arg: pointer);
+begin
+  El.ClearTypeReferences(Self);
+  if arg=nil then ;
+end;
+
+procedure TPasClassType.SetParent(const AValue: TPasElement);
+begin
+  if (AValue=nil) and (Parent<>nil) then
+    begin
+    // parent is cleared
+    // -> clear all child references to this class (releasing loops)
+    ForEachCall(@ClearChildReferences,nil);
+    end;
+  inherited SetParent(AValue);
+end;
+
 constructor TPasClassType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
@@ -2914,6 +3002,7 @@ begin
   ReleaseAndNil(TPasElement(Expr));
   ReleaseAndNil(TPasElement(LibraryName));
   ReleaseAndNil(TPasElement(ExportName));
+  ReleaseAndNil(TPasElement(AbsoluteExpr));
   inherited Destroy;
 end;
 
@@ -3422,6 +3511,12 @@ begin
   ForEachChildCall(aMethodCall,Arg,DestType,true);
 end;
 
+procedure TPasPointerType.ClearTypeReferences(aType: TPasElement);
+begin
+  if DestType=aType then
+    ReleaseAndNil(TPasElement(DestType));
+end;
+
 function TPasAliasType.GetDeclaration(full: Boolean): string;
 begin
   Result:=DestType.Name;
@@ -3436,6 +3531,12 @@ begin
   ForEachChildCall(aMethodCall,Arg,DestType,true);
 end;
 
+procedure TPasAliasType.ClearTypeReferences(aType: TPasElement);
+begin
+  if DestType=aType then
+    ReleaseAndNil(TPasElement(DestType));
+end;
+
 function TPasClassOfType.GetDeclaration (full : boolean) : string;
 begin
   Result:='Class of '+DestType.Name;
@@ -3625,6 +3726,12 @@ begin
   ForEachChildCall(aMethodCall,Arg,EnumType,true);
 end;
 
+procedure TPasRecordType.ClearChildReferences(El: TPasElement; arg: pointer);
+begin
+  El.ClearTypeReferences(Self);
+  if arg=nil then ;
+end;
+
 procedure TPasRecordType.GetMembers(S: TStrings);
 
 Var
@@ -3681,6 +3788,17 @@ begin
   end;
 end;
 
+procedure TPasRecordType.SetParent(const AValue: TPasElement);
+begin
+  if (AValue=nil) and (Parent<>nil) then
+    begin
+    // parent is cleared
+    // -> clear all child references to this class (releasing loops)
+    ForEachCall(@ClearChildReferences,nil);
+    end;
+  inherited SetParent(AValue);
+end;
+
 function TPasRecordType.GetDeclaration (full : boolean) : string;
 
 Var
@@ -3877,6 +3995,15 @@ begin
   inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,VarType,true);
   ForEachChildCall(aMethodCall,Arg,Expr,false);
+  ForEachChildCall(aMethodCall,Arg,LibraryName,false);
+  ForEachChildCall(aMethodCall,Arg,ExportName,false);
+  ForEachChildCall(aMethodCall,Arg,AbsoluteExpr,false);
+end;
+
+procedure TPasVariable.ClearTypeReferences(aType: TPasElement);
+begin
+  if VarType=aType then
+    ReleaseAndNil(TPasElement(VarType));
 end;
 
 
@@ -4235,6 +4362,12 @@ begin
   ForEachChildCall(aMethodCall,Arg,ValueExpr,false);
 end;
 
+procedure TPasArgument.ClearTypeReferences(aType: TPasElement);
+begin
+  if ArgType=aType then
+    ReleaseAndNil(TPasElement(ArgType));
+end;
+
 function TPasArgument.Value: String;
 begin
   If Assigned(ValueExpr) then
@@ -4596,6 +4729,12 @@ begin
   inherited ForEachCall(aMethodCall, Arg);
 end;
 
+procedure TPasImplExceptOn.ClearTypeReferences(aType: TPasElement);
+begin
+  if TypeEl=aType then
+    ReleaseAndNil(TPasElement(TypeEl));
+end;
+
 function TPasImplExceptOn.VariableName: String;
 begin
   If assigned(VarEl) then

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -381,6 +381,7 @@ begin
   for i:=0 to FOverrides.Count-1 do
     TPasElement(FOverrides[i]).Release;
   FreeAndNil(FOverrides);
+  Element:=nil;
   inherited Destroy;
 end;